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

Last change on this file since 2711 was 2711, checked in by suehring, 4 years ago

Subroutine renamed in order to avoid some double naming

  • Property svn:keywords set to Id
File size: 186.2 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-2017 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: netcdf_data_input_mod.f90 2711 2017-12-20 17:04:49Z suehring $
27! Rename subroutine close_file to avoid double-naming. 
28!
29! 2700 2017-12-15 14:12:35Z suehring
30! Initial revision
31!
32!
33!
34!
35! Authors:
36! --------
37! @author Matthias Suehring
38!
39! Description:
40! ------------
41!> Modulue contains routines to input data according to Palm input data       
42!> standart using dynamic and static input files.
43!>
44!> @todo - Order input alphabetically
45!> @todo - Revise error messages and error numbers
46!> @todo - Input of missing quantities (chemical species, emission rates)
47!> @todo - Defninition and input of still missing variable attributes
48!> @todo - Input of initial geostrophic wind profiles with cyclic conditions.
49!------------------------------------------------------------------------------!
50 MODULE netcdf_data_input_mod
51 
52    USE control_parameters,                                                    &
53        ONLY:  coupling_char, io_blocks, io_group
54
55    USE kinds
56
57#if defined ( __netcdf )
58    USE NETCDF
59#endif
60
61    USE pegrid
62
63!
64!-- Define data type for nesting in larger-scale models like COSMO.
65!-- Data type comprises u, v, w, pt, and q at lateral and top boundaries.
66    TYPE force_type
67
68       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names
69
70       INTEGER(iwp) ::  nt     !< number of time levels in dynamic input file
71       INTEGER(iwp) ::  nzu    !< number of vertical levels on scalar grid in dynamic input file
72       INTEGER(iwp) ::  nzw    !< number of vertical levels on w grid in dynamic input file
73       INTEGER(iwp) ::  tind   !< time index for reference time in large-scale forcing data
74       INTEGER(iwp) ::  tind_p !< time index for following time in large-scale forcing data
75
76       LOGICAL      ::  init         = .FALSE.
77       LOGICAL      ::  interpolated = .FALSE.
78       LOGICAL      ::  from_file    = .FALSE.
79
80       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surface_pressure !< time dependent surface pressure
81       REAL(wp), DIMENSION(:), ALLOCATABLE ::  time             !< time levels in dynamic input file
82       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu_atmos         !< vertical levels at scalar grid in dynamic input file
83       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zw_atmos         !< vertical levels at w grid in dynamic input file
84
85       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_left   !< u-component at left boundary
86       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_left   !< v-component at left boundary
87       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_left   !< w-component at left boundary
88       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_left   !< mixing ratio at left boundary
89       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_left  !< potentital temperautre at left boundary
90
91       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_north  !< u-component at north boundary
92       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_north  !< v-component at north boundary
93       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_north  !< w-component at north boundary
94       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_north  !< mixing ratio at north boundary
95       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_north !< potentital temperautre at north boundary
96
97       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_right  !< u-component at right boundary
98       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_right  !< v-component at right boundary
99       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_right  !< w-component at right boundary
100       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_right  !< mixing ratio at right boundary
101       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_right !< potentital temperautre at right boundary
102
103       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_south  !< u-component at south boundary
104       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_south  !< v-component at south boundary
105       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_south  !< w-component at south boundary
106       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_south  !< mixing ratio at south boundary
107       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_south !< potentital temperautre at south boundary
108
109       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_top    !< u-component at top boundary
110       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_top    !< v-component at top boundary
111       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_top    !< w-component at top boundary
112       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_top    !< mixing ratio at top boundary
113       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_top   !< potentital temperautre at top boundary
114
115    END TYPE force_type
116
117    TYPE init_type
118
119       INTEGER(iwp) ::  lod_msoil !< level of detail - soil moisture
120       INTEGER(iwp) ::  lod_pt    !< level of detail - pt
121       INTEGER(iwp) ::  lod_q     !< level of detail - q
122       INTEGER(iwp) ::  lod_tsoil !< level of detail - soil temperature
123       INTEGER(iwp) ::  lod_u     !< level of detail - u-component
124       INTEGER(iwp) ::  lod_v     !< level of detail - v-component
125       INTEGER(iwp) ::  lod_w     !< level of detail - w-component
126       INTEGER(iwp) ::  nx        !< number of scalar grid points along x in dynamic input file
127       INTEGER(iwp) ::  nxu       !< number of u grid points along x in dynamic input file
128       INTEGER(iwp) ::  ny        !< number of scalar grid points along y in dynamic input file
129       INTEGER(iwp) ::  nyv       !< number of v grid points along y in dynamic input file
130       INTEGER(iwp) ::  nzs       !< number of vertical soil levels in dynamic input file
131       INTEGER(iwp) ::  nzu       !< number of vertical levels on scalar grid in dynamic input file
132       INTEGER(iwp) ::  nzw       !< number of vertical levels on w grid in dynamic input file
133
134       LOGICAL ::  from_file_msoil  = .FALSE. !< flag indicating whether soil moisture is already initialized from file
135       LOGICAL ::  from_file_pt     = .FALSE. !< flag indicating whether pt is already initialized from file
136       LOGICAL ::  from_file_q      = .FALSE. !< flag indicating whether q is already initialized from file 
137       LOGICAL ::  from_file_tsoil  = .FALSE. !< flag indicating whether soil temperature is already initialized from file
138       LOGICAL ::  from_file_u      = .FALSE. !< flag indicating whether u is already initialized from file
139       LOGICAL ::  from_file_v      = .FALSE. !< flag indicating whether v is already initialized from file
140       LOGICAL ::  from_file_w      = .FALSE. !< flag indicating whether w is already initialized from file
141
142       REAL(wp) ::  fill_msoil       !< fill value for soil moisture
143       REAL(wp) ::  fill_pt          !< fill value for pt
144       REAL(wp) ::  fill_q           !< fill value for q
145       REAL(wp) ::  fill_tsoil       !< fill value for soil temperature
146       REAL(wp) ::  fill_u           !< fill value for u
147       REAL(wp) ::  fill_v           !< fill value for v
148       REAL(wp) ::  fill_w           !< fill value for w
149       REAL(wp) ::  latitude         !< latitude of the southern model boundary
150       REAL(wp) ::  longitude        !< longitude of the western model boundary
151
152       REAL(wp), DIMENSION(:), ALLOCATABLE ::  msoil_init   !< initial vertical profile of soil moisture
153       REAL(wp), DIMENSION(:), ALLOCATABLE ::  pt_init      !< initial vertical profile of pt
154       REAL(wp), DIMENSION(:), ALLOCATABLE ::  q_init       !< initial vertical profile of q
155       REAL(wp), DIMENSION(:), ALLOCATABLE ::  tsoil_init   !< initial vertical profile of soil temperature
156       REAL(wp), DIMENSION(:), ALLOCATABLE ::  u_init       !< initial vertical profile of u
157       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ug_init      !< initial vertical profile of ug
158       REAL(wp), DIMENSION(:), ALLOCATABLE ::  v_init       !< initial vertical profile of v
159       REAL(wp), DIMENSION(:), ALLOCATABLE ::  vg_init      !< initial vertical profile of ug
160       REAL(wp), DIMENSION(:), ALLOCATABLE ::  w_init       !< initial vertical profile of w
161       REAL(wp), DIMENSION(:), ALLOCATABLE ::  z_soil       !< vertical levels in soil in dynamic input file, used for interpolation
162       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu_atmos     !< vertical levels at scalar grid in dynamic input file, used for interpolation
163       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zw_atmos     !< vertical levels at w grid in dynamic input file, used for interpolation
164
165
166       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  msoil        !< initial 3d soil moisture provide by Inifor and interpolated onto soil grid
167       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  tsoil        !< initial 3d soil temperature provide by Inifor and interpolated onto soil grid
168
169    END TYPE init_type
170
171!
172!-- Define data structures for different input data types.
173!-- 8-bit Integer 2D
174    TYPE int_2d_8bit
175       INTEGER(KIND=1) ::  fill = -127                      !< fill value
176       INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE ::  var !< respective variable
177       
178       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default values are used 
179    END TYPE int_2d_8bit
180!
181!-- 32-bit Integer 2D
182    TYPE int_2d_32bit
183       INTEGER(iwp) ::  fill = -9999                      !< fill value
184       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  var  !< respective variable
185
186       LOGICAL ::  from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used 
187    END TYPE int_2d_32bit
188
189!
190!-- Define data type to read 2D real variables
191    TYPE real_2d
192       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default values are used 
193
194       REAL(wp) ::  fill = -9999.9_wp                !< fill value
195       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var !< respective variable
196    END TYPE real_2d
197
198!
199!-- Define data type to read 2D real variables
200    TYPE real_3d
201       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default values are used 
202
203       INTEGER(iwp) ::  nz   !< number of grid points along vertical dimension                     
204
205       REAL(wp) ::  fill = -9999.9_wp                  !< fill value
206       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  var !< respective variable
207    END TYPE real_3d
208!
209!-- Define data structure where the dimension and type of the input depends
210!-- on the given level of detail.
211!-- For buildings, the input is either 2D float, or 3d byte.
212    TYPE build_in
213       INTEGER(iwp)    ::  lod = 1                               !< level of detail                 
214       INTEGER(KIND=1) ::  fill2 = -127                          !< fill value for lod = 2
215       INTEGER(iwp)    ::  nz                                    !< number of vertical layers in file
216       INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE ::  var_3d !< 3d variable (lod = 2)
217
218       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default values are used 
219
220       REAL(wp)                              ::  fill1 = -9999.9_wp !< fill values for lod = 1
221       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var_2d             !< 2d variable (lod = 1)
222    END TYPE build_in
223
224!
225!-- For soil_type, the input is either 2D or 3D one-byte integer.
226    TYPE soil_in
227       INTEGER(iwp)                                   ::  lod = 1      !< level of detail                 
228       INTEGER(KIND=1)                                ::  fill = -127  !< fill value for lod = 2
229       INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE   ::  var_2d       !< 2d variable (lod = 1)
230       INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE ::  var_3d       !< 3d variable (lod = 2)
231
232       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default values are used 
233    END TYPE soil_in
234
235!
236!-- Define data type for fractions between surface types
237    TYPE fracs
238       INTEGER(iwp)                            ::  nf             !< total number of fractions
239       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  nfracs         !< dimension array for fraction
240
241       LOGICAL ::  from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used 
242
243       REAL(wp)                                ::  fill = -9999.9_wp !< fill value
244       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  frac              !< respective fraction between different surface types
245    END TYPE fracs
246!
247!-- Data type for parameter lists, Depending on the given level of detail,
248!-- the input is 3D or 4D
249    TYPE pars
250       INTEGER(iwp)                            ::  lod = 1         !< level of detail
251       INTEGER(iwp)                            ::  np              !< total number of parameters
252       INTEGER(iwp)                            ::  nz              !< vertical dimension - number of soil layers
253       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  layers          !< dimension array for soil layers
254       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  pars            !< dimension array for parameters
255
256       LOGICAL ::  from_file = .FALSE.  !< flag indicating whether an input variable is available and read from file or default values are used 
257
258       REAL(wp)                                  ::  fill = -9999.9_wp !< fill value
259       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE   ::  pars_xy           !< respective parameters, level of detail = 1
260       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  pars_xyz          !< respective parameters, level of detail = 2
261    END TYPE pars
262
263    TYPE(force_type) ::  force !< input variable for lateral and top boundaries derived from large-scale model 
264
265    TYPE(init_type) ::  init_3d    !< data structure for the initialization of the 3D flow and soil fields
266    TYPE(init_type) ::  init_model !< data structure for the initialization of the model
267
268!
269!-- Define 2D variables of type NC_BYTE
270    TYPE(int_2d_8bit)  ::  albedo_type_f     !< input variable for albedo type
271    TYPE(int_2d_8bit)  ::  building_type_f   !< input variable for building type
272    TYPE(int_2d_8bit)  ::  pavement_type_f   !< input variable for pavenment type
273    TYPE(int_2d_8bit)  ::  street_crossing_f !< input variable for water type
274    TYPE(int_2d_8bit)  ::  street_type_f     !< input variable for water type
275    TYPE(int_2d_8bit)  ::  vegetation_type_f !< input variable for vegetation type
276    TYPE(int_2d_8bit)  ::  water_type_f      !< input variable for water type
277
278!
279!-- Define 2D variables of type NC_INT
280    TYPE(int_2d_32bit) ::  building_id_f     !< input variable for building ID
281!
282!-- Define 2D variables of type NC_FLOAT
283    TYPE(real_2d) ::  terrain_height_f       !< input variable for terrain height
284!
285!-- Define 3D variables of type NC_FLOAT
286    TYPE(real_3d) ::  basal_area_density_f    !< input variable for basal area density - resolved vegetation
287    TYPE(real_3d) ::  leaf_area_density_f     !< input variable for leaf area density - resolved vegetation
288    TYPE(real_3d) ::  root_area_density_lad_f !< input variable for root area density - resolved vegetation
289    TYPE(real_3d) ::  root_area_density_lsm_f !< input variable for root area density - parametrized vegetation
290
291!
292!-- Define input variable for buildings
293    TYPE(build_in) ::  buildings_f           !< input variable for buildings
294!
295!-- Define input variables for soil_type
296    TYPE(soil_in)  ::  soil_type_f           !< input variable for soil type
297
298    TYPE(fracs) ::  surface_fraction_f       !< input variable for surface fraction
299
300    TYPE(pars)  ::  albedo_pars_f              !< input variable for albedo parameters
301    TYPE(pars)  ::  building_pars_f            !< input variable for building parameters
302    TYPE(pars)  ::  pavement_pars_f            !< input variable for pavement parameters
303    TYPE(pars)  ::  pavement_subsurface_pars_f !< input variable for pavement parameters
304    TYPE(pars)  ::  soil_pars_f                !< input variable for soil parameters
305    TYPE(pars)  ::  vegetation_pars_f          !< input variable for vegetation parameters
306    TYPE(pars)  ::  water_pars_f               !< input variable for water parameters
307
308
309    CHARACTER(LEN=3)  ::  char_lod  = 'lod'         !< name of level-of-detail attribute in NetCDF file
310
311    CHARACTER(LEN=10) ::  char_fill = '_FillValue'  !< name of fill value attribute in NetCDF file
312    CHARACTER(LEN=10) ::  char_lon  = 'origin_lon'  !< name of global attribute for longitude in NetCDF file
313    CHARACTER(LEN=10) ::  char_lat  = 'origin_lat'  !< name of global attribute for latitude in NetCDF file
314
315    CHARACTER(LEN=100) ::  input_file_static  = 'PIDS_STATIC'  !< Name of file which comprises static input data
316    CHARACTER(LEN=100) ::  input_file_dynamic = 'PIDS_DYNAMIC' !< Name of file which comprises dynamic input data
317
318    INTEGER(iwp) ::  nc_stat         !< return value of nf90 function call
319
320    LOGICAL ::  input_pids_static  = .FALSE.   !< Flag indicating whether Palm-input-data-standard file containing static information exists
321    LOGICAL ::  input_pids_dynamic = .FALSE.   !< Flag indicating whether Palm-input-data-standard file containing dynamic information exists
322
323    SAVE
324
325    PRIVATE
326
327    INTERFACE netcdf_data_input_interpolate
328       MODULE PROCEDURE netcdf_data_input_interpolate_1d
329       MODULE PROCEDURE netcdf_data_input_interpolate_1d_soil
330       MODULE PROCEDURE netcdf_data_input_interpolate_2d
331       MODULE PROCEDURE netcdf_data_input_interpolate_3d
332    END INTERFACE netcdf_data_input_interpolate
333
334    INTERFACE netcdf_data_input_check_dynamic
335       MODULE PROCEDURE netcdf_data_input_check_dynamic
336    END INTERFACE netcdf_data_input_check_dynamic
337
338    INTERFACE netcdf_data_input_check_static
339       MODULE PROCEDURE netcdf_data_input_check_static
340    END INTERFACE netcdf_data_input_check_static
341
342    INTERFACE netcdf_data_input_inquire_file
343       MODULE PROCEDURE netcdf_data_input_inquire_file
344    END INTERFACE netcdf_data_input_inquire_file
345
346    INTERFACE netcdf_data_input_init
347       MODULE PROCEDURE netcdf_data_input_init
348    END INTERFACE netcdf_data_input_init
349
350    INTERFACE netcdf_data_input_init_3d
351       MODULE PROCEDURE netcdf_data_input_init_3d
352    END INTERFACE netcdf_data_input_init_3d
353
354    INTERFACE netcdf_data_input_lsf
355       MODULE PROCEDURE netcdf_data_input_lsf
356    END INTERFACE netcdf_data_input_lsf
357
358    INTERFACE netcdf_data_input_surface_data
359       MODULE PROCEDURE netcdf_data_input_surface_data
360    END INTERFACE netcdf_data_input_surface_data
361
362    INTERFACE netcdf_data_input_topo
363       MODULE PROCEDURE netcdf_data_input_topo
364    END INTERFACE netcdf_data_input_topo
365
366    INTERFACE get_variable
367       MODULE PROCEDURE get_variable_1d_int
368       MODULE PROCEDURE get_variable_1d_real
369       MODULE PROCEDURE get_variable_2d_int8
370       MODULE PROCEDURE get_variable_2d_int32
371       MODULE PROCEDURE get_variable_2d_real
372       MODULE PROCEDURE get_variable_3d_int8
373       MODULE PROCEDURE get_variable_3d_real
374       MODULE PROCEDURE get_variable_4d_real
375    END INTERFACE get_variable
376
377    INTERFACE get_attribute
378       MODULE PROCEDURE get_attribute_real
379       MODULE PROCEDURE get_attribute_int8
380       MODULE PROCEDURE get_attribute_int32
381       MODULE PROCEDURE get_attribute_string
382    END INTERFACE get_attribute
383
384!
385!-- Public variables
386    PUBLIC albedo_pars_f, albedo_type_f, basal_area_density_f, buildings_f,    &
387           building_id_f, building_pars_f, building_type_f, force, init_3d,    &
388           init_model, input_file_static, input_pids_static,                   &
389           input_pids_dynamic, leaf_area_density_f,                            &
390           pavement_pars_f, pavement_subsurface_pars_f, pavement_type_f,       &
391           root_area_density_lad_f, root_area_density_lsm_f, soil_pars_f,      &
392           soil_type_f, street_crossing_f, street_type_f, surface_fraction_f,  &
393           terrain_height_f, vegetation_pars_f, vegetation_type_f,             &
394           water_pars_f, water_type_f
395
396!
397!-- Public subroutines
398    PUBLIC netcdf_data_input_check_dynamic, netcdf_data_input_check_static,    &
399           netcdf_data_input_inquire_file,                                     &
400           netcdf_data_input_init, netcdf_data_input_init_3d,                  &
401           netcdf_data_input_interpolate, netcdf_data_input_lsf,               &
402           netcdf_data_input_surface_data, netcdf_data_input_topo
403
404 CONTAINS
405
406!------------------------------------------------------------------------------!
407! Description:
408! ------------
409!> Inquires whether NetCDF input files according to Palm-input-data standard
410!> exist. Moreover, basic checks are performed.
411!------------------------------------------------------------------------------!
412    SUBROUTINE netcdf_data_input_inquire_file
413
414       USE control_parameters,                                                 &
415           ONLY:  land_surface, message_string, topo_no_distinct, urban_surface
416
417       IMPLICIT NONE
418
419       LOGICAL ::  check_nest  !< flag indicating whether a check passed or not
420
421#if defined ( __netcdf )
422       INQUIRE( FILE = TRIM( input_file_static ) // TRIM( coupling_char ),     &
423                EXIST = input_pids_static  )
424       INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ),    &
425                EXIST = input_pids_dynamic )
426#endif
427
428       IF ( .NOT. input_pids_static )  THEN
429          message_string = 'File ' // TRIM( input_file_static ) //             &
430                           TRIM( coupling_char ) // ' does ' //                &
431                           'not exist - input from external files ' //         &
432                           'is read from separate ASCII files, ' //            &
433                           'if required.' 
434          CALL message( 'netcdf_data_input_mod', 'PA0430', 0, 0, 0, 6, 0 )
435!
436!--       As long as topography can be input via ASCII format, no distinction
437!--       between building and terrain can be made. This case, classify all
438!--       surfaces as default type. Same in case land-surface and urban-surface
439!--       model are not applied.
440          topo_no_distinct = .TRUE. 
441       ENDIF
442
443    END SUBROUTINE netcdf_data_input_inquire_file
444
445!------------------------------------------------------------------------------!
446! Description:
447! ------------
448!> Reads global attributes required for initialization of the model.
449!------------------------------------------------------------------------------!
450    SUBROUTINE netcdf_data_input_init
451
452       IMPLICIT NONE
453
454       INTEGER(iwp) ::  id_mod   !< NetCDF id of input file
455       INTEGER(iwp) ::  ii       !< running index for IO blocks
456
457       IF ( .NOT. input_pids_static )  RETURN 
458
459       DO  ii = 0, io_blocks-1
460          IF ( ii == io_group )  THEN
461#if defined ( __netcdf )
462!
463!--          Open file in read-only mode
464             CALL open_read_file( TRIM( input_file_static ) //                 &
465                                  TRIM( coupling_char ), id_mod )
466!
467!--          Read global attribute for latitude and longitude
468             CALL get_attribute( id_mod, char_lat,                             &
469                                 init_model%latitude, .TRUE. )
470
471             CALL get_attribute( id_mod, char_lon,                             &
472                                 init_model%longitude, .TRUE. )
473!
474!--          Finally, close input file
475             CALL close_input_file( id_mod )
476#endif
477          ENDIF
478#if defined( __parallel )
479          CALL MPI_BARRIER( comm2d, ierr )
480#endif
481       ENDDO
482
483    END SUBROUTINE netcdf_data_input_init
484
485!------------------------------------------------------------------------------!
486! Description:
487! ------------
488!> Reads surface classification data, such as vegetation and soil type, etc. .
489!------------------------------------------------------------------------------!
490    SUBROUTINE netcdf_data_input_surface_data
491
492       USE control_parameters,                                                 &
493           ONLY:  bc_lr_cyc, bc_ns_cyc, land_surface, message_string,          &
494                  urban_surface
495
496       USE indices,                                                            &
497           ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg
498
499       IMPLICIT NONE
500
501       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names  !< variable names in static input file
502
503       INTEGER(iwp) ::  i         !< running index along x-direction
504       INTEGER(iwp) ::  ii        !< running index for IO blocks
505       INTEGER(iwp) ::  id_surf   !< NetCDF id of input file
506       INTEGER(iwp) ::  j         !< running index along y-direction
507       INTEGER(iwp) ::  k         !< running index along z-direction
508       INTEGER(iwp) ::  k2        !< running index
509       INTEGER(iwp) ::  num_vars  !< number of variables in input file
510       INTEGER(iwp) ::  nz_soil   !< number of soil layers in file
511
512       INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  var_exchange_int !< dummy variables used to exchange 32-bit Integer arrays
513       INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE  ::  var_dum_int_3d !< dummy variables used to exchange real arrays
514
515       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  var_exchange_real !< dummy variables used to exchange real arrays
516
517       REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  var_dum_real_3d !< dummy variables used to exchange real arrays
518       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  var_dum_real_4d !< dummy variables used to exchange real arrays
519
520!
521!--    If not static input file is available, skip this routine
522       IF ( .NOT. input_pids_static )  RETURN 
523!
524!--    Moreover, skip routine if no land-surface or urban-surface module are
525!--    applied as no variable is used anyway. 
526       IF (  .NOT. land_surface  .OR.  .NOT. urban_surface )  RETURN
527!
528!--    Initialize dummy arrays used for ghost-point exchange
529       var_exchange_int  = 0
530       var_exchange_real = 0.0_wp
531
532       DO  ii = 0, io_blocks-1
533          IF ( ii == io_group )  THEN
534#if defined ( __netcdf )
535!
536!--          Open file in read-only mode
537             CALL open_read_file( TRIM( input_file_static ) //                 &
538                                  TRIM( coupling_char ) , id_surf )
539
540!
541!--          At first, inquire all variable names.
542!--          This will be used to check whether an optional input variable exist
543!--          or not.
544             CALL inquire_num_variables( id_surf, num_vars )
545
546             ALLOCATE( var_names(1:num_vars) )
547             CALL inquire_variable_names( id_surf, var_names )
548
549!
550!--          Read vegetation type and required attributes
551             IF ( check_existence( var_names, 'vegetation_type' ) )  THEN
552                vegetation_type_f%from_file = .TRUE.
553                CALL get_attribute( id_surf, char_fill,                        &
554                                    vegetation_type_f%fill,                    &
555                                    .FALSE., 'vegetation_type' )
556!
557!--             PE-wise reading of 2D vegetation type.
558                ALLOCATE ( vegetation_type_f%var(nys:nyn,nxl:nxr)  )
559
560                DO  i = nxl, nxr
561                   CALL get_variable( id_surf, 'vegetation_type',              &
562                                      i, vegetation_type_f%var(:,i) )
563                ENDDO
564             ELSE
565                vegetation_type_f%from_file = .FALSE.
566             ENDIF
567
568!
569!--          Read soil type and required attributes
570             IF ( check_existence( var_names, 'soil_type' ) )  THEN
571                   soil_type_f%from_file = .TRUE. 
572!
573!--             Note, lod is currently not on file; skip for the moment
574!                 CALL get_attribute( id_surf, char_lod,                       &
575!                                            soil_type_f%lod,                  &
576!                                            .FALSE., 'soil_type' )
577                CALL get_attribute( id_surf, char_fill,                        &
578                                    soil_type_f%fill,                          &
579                                    .FALSE., 'soil_type' ) 
580
581                IF ( soil_type_f%lod == 1 )  THEN
582!
583!--                PE-wise reading of 2D soil type.
584                   ALLOCATE ( soil_type_f%var_2d(nys:nyn,nxl:nxr)  )
585                   DO  i = nxl, nxr
586                      CALL get_variable( id_surf, 'soil_type',                 &
587                                         i, soil_type_f%var_2d(:,i) ) 
588                   ENDDO
589                ELSEIF ( soil_type_f%lod == 2 )  THEN
590!
591!--                Obtain number of soil layers from file.
592                   CALL get_dimension_length( id_surf, nz_soil, 'zsoil' )
593!
594!--                PE-wise reading of 3D soil type.
595                   ALLOCATE ( soil_type_f%var_3d(0:nz_soil,nys:nyn,nxl:nxr) )
596                   DO  i = nxl, nxr
597                      DO  j = nys, nyn
598                         CALL get_variable( id_surf, 'soil_type', i, j,        &
599                                            soil_type_f%var_3d(:,j,i) )   
600                      ENDDO
601                   ENDDO
602                ENDIF
603             ELSE
604                soil_type_f%from_file = .FALSE.
605             ENDIF
606
607!
608!--          Read pavement type and required attributes
609             IF ( check_existence( var_names, 'pavement_type' ) )  THEN
610                pavement_type_f%from_file = .TRUE. 
611                CALL get_attribute( id_surf, char_fill,                        &
612                                    pavement_type_f%fill, .FALSE.,             &
613                                    'pavement_type' ) 
614!
615!--             PE-wise reading of 2D pavement type.
616                ALLOCATE ( pavement_type_f%var(nys:nyn,nxl:nxr)  )
617                DO  i = nxl, nxr
618                   CALL get_variable( id_surf, 'pavement_type',                &
619                                      i, pavement_type_f%var(:,i) ) 
620                ENDDO
621             ELSE
622                pavement_type_f%from_file = .FALSE.
623             ENDIF
624
625!
626!--          Read water type and required attributes
627             IF ( check_existence( var_names, 'water_type' ) )  THEN
628                water_type_f%from_file = .TRUE. 
629                CALL get_attribute( id_surf, char_fill, water_type_f%fill,     &
630                                    .FALSE., 'water_type' )
631!
632!--             PE-wise reading of 2D water type.
633                ALLOCATE ( water_type_f%var(nys:nyn,nxl:nxr)  )
634                DO  i = nxl, nxr
635                   CALL get_variable( id_surf, 'water_type', i,                &
636                                      water_type_f%var(:,i) ) 
637                ENDDO
638             ELSE
639                water_type_f%from_file = .FALSE.
640             ENDIF
641!
642!--          Read surface fractions and related information
643             IF ( check_existence( var_names, 'surface_fraction' ) )  THEN
644                surface_fraction_f%from_file = .TRUE. 
645                CALL get_attribute( id_surf, char_fill,                        &
646                                    surface_fraction_f%fill,                   &
647                                    .FALSE., 'surface_fraction' )
648!
649!--             Inquire number of surface fractions
650                CALL get_dimension_length( id_surf,                            &
651                                           surface_fraction_f%nf,              &
652                                           'nsurface_fraction' )
653!           
654!--             Allocate dimension array and input array for surface fractions
655                ALLOCATE( surface_fraction_f%nfracs(0:surface_fraction_f%nf-1) )
656                ALLOCATE( surface_fraction_f%frac(0:surface_fraction_f%nf-1,   &
657                                                  nys:nyn,nxl:nxr) )
658!
659!--             Get dimension of surface fractions
660                CALL get_variable( id_surf, 'nsurface_fraction',               &
661                                   surface_fraction_f%nfracs )
662!
663!--             Read surface fractions
664                DO  i = nxl, nxr
665                   DO  j = nys, nyn
666                      CALL get_variable( id_surf, 'surface_fraction', i, j,    &
667                                         surface_fraction_f%frac(:,j,i) ) 
668                   ENDDO
669                ENDDO
670             ELSE
671                surface_fraction_f%from_file = .FALSE. 
672             ENDIF
673!
674!--          Read building parameters and related information
675             IF ( check_existence( var_names, 'building_pars' ) )  THEN
676                building_pars_f%from_file = .TRUE. 
677                CALL get_attribute( id_surf, char_fill,                        &
678                                    building_pars_f%fill,                      &
679                                    .FALSE., 'building_pars' ) 
680!
681!--             Inquire number of building parameters
682                CALL get_dimension_length( id_surf,                            &
683                                           building_pars_f%np,                 &
684                                           'nbuilding_pars' )
685!           
686!--             Allocate dimension array and input array for building parameters
687                ALLOCATE( building_pars_f%pars(0:building_pars_f%np-1) )
688                ALLOCATE( building_pars_f%pars_xy(0:building_pars_f%np-1,      &
689                                                  nys:nyn,nxl:nxr) )
690!
691!--             Get dimension of building parameters
692                CALL get_variable( id_surf, 'nbuilding_pars',                  &
693                                   building_pars_f%pars )
694!
695!--             Read building_pars
696                DO  i = nxl, nxr
697                   DO  j = nys, nyn
698                      CALL get_variable( id_surf, 'building_pars', i, j,       &
699                                         building_pars_f%pars_xy(:,j,i) )   
700                   ENDDO
701                ENDDO
702             ELSE
703                building_pars_f%from_file = .FALSE. 
704             ENDIF
705
706!
707!--          Read albedo type and required attributes
708             IF ( check_existence( var_names, 'albedo_type' ) )  THEN
709                albedo_type_f%from_file = .TRUE. 
710                CALL get_attribute( id_surf, char_fill, albedo_type_f%fill,    &
711                                    .FALSE.,  'albedo_type' ) 
712!
713!--             PE-wise reading of 2D water type.
714                ALLOCATE ( albedo_type_f%var(nys:nyn,nxl:nxr)  )
715                DO  i = nxl, nxr
716                   CALL get_variable( id_surf, 'albedo_type',                  &
717                                      i, albedo_type_f%var(:,i) ) 
718                ENDDO
719             ELSE
720                albedo_type_f%from_file = .FALSE.
721             ENDIF
722!
723!--          Read albedo parameters and related information
724             IF ( check_existence( var_names, 'albedo_pars' ) )  THEN
725                albedo_pars_f%from_file = .TRUE. 
726                CALL get_attribute( id_surf, char_fill, albedo_pars_f%fill,    &
727                                    .FALSE., 'albedo_pars' ) 
728!
729!--             Inquire number of albedo parameters
730                CALL get_dimension_length( id_surf, albedo_pars_f%np,          &
731                                           'nalbedo_pars' )
732!           
733!--             Allocate dimension array and input array for albedo parameters
734                ALLOCATE( albedo_pars_f%pars(0:albedo_pars_f%np-1) )
735                ALLOCATE( albedo_pars_f%pars_xy(0:albedo_pars_f%np-1,          &
736                                                nys:nyn,nxl:nxr) )
737!
738!--             Get dimension of albedo parameters
739                CALL get_variable( id_surf, 'nalbedo_pars', albedo_pars_f%pars )
740
741                DO  i = nxl, nxr
742                   DO  j = nys, nyn
743                      CALL get_variable( id_surf, 'albedo_pars', i, j,         &
744                                         albedo_pars_f%pars_xy(:,j,i) )   
745                   ENDDO
746                ENDDO
747             ELSE
748                albedo_pars_f%from_file = .FALSE. 
749             ENDIF
750
751!
752!--          Read pavement parameters and related information
753             IF ( check_existence( var_names, 'pavement_pars' ) )  THEN
754                pavement_pars_f%from_file = .TRUE. 
755                CALL get_attribute( id_surf, char_fill,                        &
756                                    pavement_pars_f%fill,                      &
757                                    .FALSE., 'pavement_pars' ) 
758!
759!--             Inquire number of pavement parameters
760                CALL get_dimension_length( id_surf, pavement_pars_f%np,        &
761                                           'npavement_pars' )
762!           
763!--             Allocate dimension array and input array for pavement parameters
764                ALLOCATE( pavement_pars_f%pars(0:pavement_pars_f%np-1) )
765                ALLOCATE( pavement_pars_f%pars_xy(0:pavement_pars_f%np-1,      &
766                                                  nys:nyn,nxl:nxr) )
767!
768!--             Get dimension of pavement parameters
769                CALL get_variable( id_surf, 'npavement_pars',                  &
770                                   pavement_pars_f%pars )
771   
772                DO  i = nxl, nxr
773                   DO  j = nys, nyn
774                      CALL get_variable( id_surf, 'pavement_pars', i, j,       &
775                                         pavement_pars_f%pars_xy(:,j,i) )   
776                   ENDDO
777                ENDDO
778             ELSE
779                pavement_pars_f%from_file = .FALSE. 
780             ENDIF
781
782!
783!--          Read pavement subsurface parameters and related information
784             IF ( check_existence( var_names, 'pavement_subsurface_pars' ) )   &
785             THEN
786                pavement_subsurface_pars_f%from_file = .TRUE. 
787                CALL get_attribute( id_surf, char_fill,                        &
788                                    pavement_subsurface_pars_f%fill,           &
789                                    .FALSE., 'pavement_subsurface_pars' ) 
790!
791!--             Inquire number of parameters
792                CALL get_dimension_length( id_surf,                            &
793                                           pavement_subsurface_pars_f%np,      &
794                                           'npavement_subsurface_pars' )
795!
796!--             Inquire number of soil layers
797                CALL get_dimension_length( id_surf,                            &
798                                           pavement_subsurface_pars_f%nz,      &
799                                           'zsoil' )
800!           
801!--             Allocate dimension array and input array for pavement parameters
802                ALLOCATE( pavement_subsurface_pars_f%pars                      &
803                                  (0:pavement_subsurface_pars_f%np-1) )
804                ALLOCATE( pavement_subsurface_pars_f%pars_xyz                  &
805                                  (0:pavement_subsurface_pars_f%np-1,          &
806                                   0:pavement_subsurface_pars_f%nz-1,          &
807                                   nys:nyn,nxl:nxr) )
808!
809!--             Get dimension of pavement parameters
810                CALL get_variable( id_surf, 'npavement_subsurface_pars',       &
811                                   pavement_subsurface_pars_f%pars )
812   
813                DO  i = nxl, nxr
814                   DO  j = nys, nyn
815                      CALL get_variable(                                       &
816                                  id_surf, 'pavement_subsurface_pars',         &
817                                  i, j,                                        &
818                                  pavement_subsurface_pars_f%pars_xyz(:,:,j,i),&
819                                  pavement_subsurface_pars_f%nz,               &
820                                  pavement_subsurface_pars_f%np )   
821                   ENDDO
822                ENDDO
823             ELSE
824                pavement_subsurface_pars_f%from_file = .FALSE. 
825             ENDIF
826
827
828!
829!--          Read vegetation parameters and related information
830             IF ( check_existence( var_names, 'vegetation_pars' ) )  THEN
831                vegetation_pars_f%from_file = .TRUE. 
832                CALL get_attribute( id_surf, char_fill,                        &
833                                    vegetation_pars_f%fill,                    &
834                                    .FALSE.,  'vegetation_pars' )
835!
836!--             Inquire number of vegetation parameters
837                CALL get_dimension_length( id_surf, vegetation_pars_f%np,      &
838                                           'nvegetation_pars' )
839!           
840!--             Allocate dimension array and input array for surface fractions
841                ALLOCATE( vegetation_pars_f%pars(0:vegetation_pars_f%np-1) )
842                ALLOCATE( vegetation_pars_f%pars_xy(0:vegetation_pars_f%np-1,  &
843                                                    nys:nyn,nxl:nxr) )
844!
845!--             Get dimension of the parameters
846                CALL get_variable( id_surf, 'nvegetation_pars',                &
847                                   vegetation_pars_f%pars )
848
849                DO  i = nxl, nxr
850                   DO  j = nys, nyn
851                      CALL get_variable( id_surf, 'vegetation_pars', i, j,     &
852                                         vegetation_pars_f%pars_xy(:,j,i) ) 
853                   ENDDO
854                ENDDO
855             ELSE
856                vegetation_pars_f%from_file = .FALSE. 
857             ENDIF
858
859!
860!--          Read root parameters/distribution and related information
861             IF ( check_existence( var_names, 'soil_pars' ) )  THEN
862                soil_pars_f%from_file = .TRUE. 
863                CALL get_attribute( id_surf, char_fill,                        &
864                                    soil_pars_f%fill,                          & 
865                                    .FALSE., 'soil_pars' ) 
866
867                CALL get_attribute( id_surf, char_lod,                         &
868                                    soil_pars_f%lod,                           &
869                                    .FALSE., 'soil_pars' ) 
870
871!
872!--             Inquire number of soil parameters
873                CALL get_dimension_length( id_surf,                            &
874                                           soil_pars_f%np,                     &
875                                           'nsoil_pars' )
876!
877!--             Read parameters array
878                ALLOCATE( soil_pars_f%pars(0:soil_pars_f%np-1) )
879                CALL get_variable( id_surf, 'nsoil_pars', soil_pars_f%pars )
880
881!
882!--             In case of level of detail 2, also inquire number of vertical
883!--             soil layers, allocate memory and read the respective dimension
884                IF ( soil_pars_f%lod == 2 )  THEN
885                   CALL get_dimension_length( id_surf, soil_pars_f%nz, 'zsoil' )
886
887                   ALLOCATE( soil_pars_f%layers(0:soil_pars_f%nz-1) )
888                   CALL get_variable( id_surf, 'zsoil', soil_pars_f%layers )
889
890                ENDIF
891
892!
893!--             Read soil parameters, depending on level of detail
894                IF ( soil_pars_f%lod == 1 )  THEN     
895                   ALLOCATE( soil_pars_f%pars_xy(0:soil_pars_f%np-1,           &
896                                                 nys:nyn,nxl:nxr) )       
897                   DO  i = nxl, nxr
898                      DO  j = nys, nyn
899                         CALL get_variable( id_surf, 'soil_pars', i, j,        &
900                                            soil_pars_f%pars_xy(:,j,i) ) 
901                      ENDDO
902                   ENDDO
903
904                ELSEIF ( soil_pars_f%lod == 2 )  THEN
905                   ALLOCATE( soil_pars_f%pars_xyz(0:soil_pars_f%np-1,          &
906                                                  0:soil_pars_f%nz-1,          &
907                                                  nys:nyn,nxl:nxr) )
908                   DO  i = nxl, nxr
909                      DO  j = nys, nyn
910                         CALL get_variable( id_surf, 'soil_pars', i, j,        &
911                                            soil_pars_f%pars_xyz(:,:,j,i),     &
912                                            soil_pars_f%nz, soil_pars_f%np ) 
913                      ENDDO
914                   ENDDO
915                ENDIF
916             ELSE
917                soil_pars_f%from_file = .FALSE. 
918             ENDIF
919
920!
921!--          Read water parameters and related information
922             IF ( check_existence( var_names, 'water_pars' ) )  THEN
923                water_pars_f%from_file = .TRUE. 
924                CALL get_attribute( id_surf, char_fill,                        &
925                                    water_pars_f%fill,                         &
926                                    .FALSE., 'water_pars' ) 
927!
928!--             Inquire number of water parameters
929                CALL get_dimension_length( id_surf,                            & 
930                                           water_pars_f%np,                    &
931                                           'nwater_pars' )
932!           
933!--             Allocate dimension array and input array for water parameters
934                ALLOCATE( water_pars_f%pars(0:water_pars_f%np-1) )
935                ALLOCATE( water_pars_f%pars_xy(0:water_pars_f%np-1,            &
936                                               nys:nyn,nxl:nxr) )
937!
938!--             Get dimension of water parameters
939                CALL get_variable( id_surf, 'nwater_pars', water_pars_f%pars )
940
941                DO  i = nxl, nxr
942                   DO  j = nys, nyn
943                      CALL get_variable( id_surf, 'water_pars', i, j,          &
944                                         water_pars_f%pars_xy(:,j,i) )   
945                   ENDDO
946                ENDDO
947             ELSE
948                water_pars_f%from_file = .FALSE. 
949             ENDIF
950
951!
952!--          Read leaf area density - resolved vegetation
953             IF ( check_existence( var_names, 'leaf_area_density' ) )  THEN
954                leaf_area_density_f%from_file = .TRUE. 
955                CALL get_attribute( id_surf, char_fill,                        &
956                                    leaf_area_density_f%fill,                  &
957                                    .FALSE., 'leaf_area_density' ) 
958!
959!--             Inquire number of vertical vegetation layer
960                CALL get_dimension_length( id_surf, leaf_area_density_f%nz,    &
961                                           'zlad' )
962!           
963!--             Allocate variable for leaf-area density
964                ALLOCATE( leaf_area_density_f%var(0:leaf_area_density_f%nz-1,  &
965                                                  nys:nyn,nxl:nxr) )
966
967                DO  i = nxl, nxr
968                   DO  j = nys, nyn
969                      CALL get_variable( id_surf, 'leaf_area_density', i, j,   &
970                                         leaf_area_density_f%var(:,j,i) ) 
971                   ENDDO
972                ENDDO
973             ELSE
974                leaf_area_density_f%from_file = .FALSE. 
975             ENDIF
976
977!
978!--          Read basal area density - resolved vegetation
979             IF ( check_existence( var_names, 'basal_area_density' ) )  THEN
980                basal_area_density_f%from_file = .TRUE. 
981                CALL get_attribute( id_surf, char_fill,                        &
982                                    basal_area_density_f%fill,                 &
983                                    .FALSE., 'basal_area_density' ) 
984!
985!--             Inquire number of vertical vegetation layer
986                CALL get_dimension_length( id_surf, basal_area_density_f%nz,   &
987                                           'zlad' )
988!           
989!--             Allocate variable
990                ALLOCATE( basal_area_density_f%var(0:basal_area_density_f%nz-1,&
991                                                   nys:nyn,nxl:nxr) )
992
993                DO  i = nxl, nxr
994                   DO  j = nys, nyn
995                      CALL get_variable( id_surf, 'basal_area_density', i, j,  &
996                                         basal_area_density_f%var(:,j,i) ) 
997                   ENDDO
998                ENDDO
999             ELSE
1000                basal_area_density_f%from_file = .FALSE. 
1001             ENDIF
1002
1003!
1004!--          Read root area density - resolved vegetation
1005             IF ( check_existence( var_names, 'root_area_density_lad' ) )  THEN
1006                root_area_density_lad_f%from_file = .TRUE. 
1007                CALL get_attribute( id_surf, char_fill,                        &
1008                                    root_area_density_lad_f%fill,              &
1009                                    .FALSE., 'root_area_density_lad' ) 
1010!
1011!--             Inquire number of vertical soil layers
1012                CALL get_dimension_length( id_surf, root_area_density_lad_f%nz,&
1013                                           'zsoil' )
1014!           
1015!--             Allocate variable
1016                ALLOCATE( root_area_density_lad_f%var                          &
1017                                            (0:root_area_density_lad_f%nz-1,   &
1018                                             nys:nyn,nxl:nxr) )
1019
1020                DO  i = nxl, nxr
1021                   DO  j = nys, nyn
1022                      CALL get_variable( id_surf, 'root_area_density_lad', i, j,&
1023                                         root_area_density_lad_f%var(:,j,i) ) 
1024                   ENDDO
1025                ENDDO
1026             ELSE
1027                root_area_density_lad_f%from_file = .FALSE. 
1028             ENDIF
1029
1030!
1031!--          Read root area density - parametrized vegetation
1032             IF ( check_existence( var_names, 'root_area_density_lsm' ) )  THEN
1033                root_area_density_lsm_f%from_file = .TRUE.
1034                CALL get_attribute( id_surf, char_fill,                        &
1035                                    root_area_density_lsm_f%fill,              &
1036                                    .FALSE., 'root_area_density_lsm' )
1037!
1038!--             Obtain number of soil layers from file and allocate variable
1039                CALL get_dimension_length( id_surf, root_area_density_lsm_f%nz,&
1040                                           'zsoil' )
1041                ALLOCATE( root_area_density_lsm_f%var                          &
1042                                              (0:root_area_density_lsm_f%nz-1, &
1043                                               nys:nyn,nxl:nxr) )
1044
1045!
1046!--             Read root-area density
1047                DO  i = nxl, nxr
1048                   DO  j = nys, nyn
1049                      CALL get_variable( id_surf, 'root_area_density_lsm',     &
1050                                         i, j,                                 &
1051                                         root_area_density_lsm_f%var(:,j,i) )   
1052                   ENDDO
1053                ENDDO
1054
1055             ELSE
1056                root_area_density_lsm_f%from_file = .FALSE.
1057             ENDIF
1058!
1059!--          Read street type and street crossing
1060             IF ( check_existence( var_names, 'street_type' ) )  THEN
1061                street_type_f%from_file = .TRUE. 
1062                CALL get_attribute( id_surf, char_fill,                        &
1063                                    street_type_f%fill, .FALSE.,               &
1064                                    'street_type' ) 
1065!
1066!--             PE-wise reading of 2D pavement type.
1067                ALLOCATE ( street_type_f%var(nys:nyn,nxl:nxr)  )
1068                DO  i = nxl, nxr
1069                   CALL get_variable( id_surf, 'street_type',                  &
1070                                      i, street_type_f%var(:,i) ) 
1071                ENDDO
1072             ELSE
1073                street_type_f%from_file = .FALSE.
1074             ENDIF
1075
1076             IF ( check_existence( var_names, 'street_crossing' ) )  THEN
1077                street_crossing_f%from_file = .TRUE. 
1078                CALL get_attribute( id_surf, char_fill,                        &
1079                                    street_crossing_f%fill, .FALSE.,           &
1080                                    'street_crossing' ) 
1081!
1082!--             PE-wise reading of 2D pavement type.
1083                ALLOCATE ( street_crossing_f%var(nys:nyn,nxl:nxr)  )
1084                DO  i = nxl, nxr
1085                   CALL get_variable( id_surf, 'street_crossing',              &
1086                                      i, street_crossing_f%var(:,i) ) 
1087                ENDDO
1088             ELSE
1089                street_crossing_f%from_file = .FALSE.
1090             ENDIF
1091!
1092!--          Still missing: root_resolved and building_surface_pars.
1093!--          Will be implemented as soon as they are available.
1094
1095!
1096!--          Finally, close input file
1097             CALL close_input_file( id_surf )
1098#endif
1099          ENDIF
1100#if defined( __parallel )
1101          CALL MPI_BARRIER( comm2d, ierr )
1102#endif
1103       ENDDO
1104!
1105!--    Exchange 1 ghost points for surface variables. Please note, ghost point
1106!--    exchange for 3D parameter lists should be revised by using additional
1107!--    MPI datatypes or rewriting exchange_horiz.
1108!--    Moreover, varialbes will be resized in the following, including ghost
1109!--    points.
1110!--    Start with 2D Integer variables. Please note, for 8-bit integer
1111!--    variables must be swapt to 32-bit integer before calling exchange_horiz.
1112       IF ( albedo_type_f%from_file )  THEN
1113          var_exchange_int                  = INT( albedo_type_f%fill, KIND = 1 )
1114          var_exchange_int(nys:nyn,nxl:nxr) =                                  &
1115                            INT( albedo_type_f%var(nys:nyn,nxl:nxr), KIND = 4 )
1116          CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp )
1117          DEALLOCATE( albedo_type_f%var )
1118          ALLOCATE( albedo_type_f%var(nysg:nyng,nxlg:nxrg) )
1119          albedo_type_f%var = INT( var_exchange_int, KIND = 1 )
1120       ENDIF
1121       IF ( pavement_type_f%from_file )  THEN
1122          var_exchange_int                  = INT( pavement_type_f%fill, KIND = 1 )
1123          var_exchange_int(nys:nyn,nxl:nxr) =                                  &
1124                          INT( pavement_type_f%var(nys:nyn,nxl:nxr), KIND = 4 )
1125          CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp )
1126          DEALLOCATE( pavement_type_f%var )
1127          ALLOCATE( pavement_type_f%var(nysg:nyng,nxlg:nxrg) )
1128          pavement_type_f%var = INT( var_exchange_int, KIND = 1 )
1129       ENDIF
1130       IF ( soil_type_f%from_file  .AND.  ALLOCATED( soil_type_f%var_2d ) )  THEN
1131          var_exchange_int                  = INT( soil_type_f%fill, KIND = 1 )
1132          var_exchange_int(nys:nyn,nxl:nxr) =                                  &
1133                            INT( soil_type_f%var_2d(nys:nyn,nxl:nxr), KIND = 4 )
1134          CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp )
1135          DEALLOCATE( soil_type_f%var_2d )
1136          ALLOCATE( soil_type_f%var_2d(nysg:nyng,nxlg:nxrg) )
1137          soil_type_f%var_2d = INT( var_exchange_int, KIND = 1 )
1138       ENDIF
1139       IF ( vegetation_type_f%from_file )  THEN
1140          var_exchange_int                  = INT( vegetation_type_f%fill, KIND = 1 )
1141          var_exchange_int(nys:nyn,nxl:nxr) =                                  &
1142                        INT( vegetation_type_f%var(nys:nyn,nxl:nxr), KIND = 4 )
1143          CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp )
1144          DEALLOCATE( vegetation_type_f%var )
1145          ALLOCATE( vegetation_type_f%var(nysg:nyng,nxlg:nxrg) )
1146          vegetation_type_f%var = INT( var_exchange_int, KIND = 1 )
1147       ENDIF
1148       IF ( water_type_f%from_file )  THEN
1149          var_exchange_int                  = INT( water_type_f%fill, KIND = 1 )
1150          var_exchange_int(nys:nyn,nxl:nxr) =                                  &
1151                         INT( water_type_f%var(nys:nyn,nxl:nxr), KIND = 4 )
1152          CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp )
1153          DEALLOCATE( water_type_f%var )
1154          ALLOCATE( water_type_f%var(nysg:nyng,nxlg:nxrg) )
1155          water_type_f%var = INT( var_exchange_int, KIND = 1 )
1156       ENDIF
1157!
1158!--    Exchange 1 ghost point for 3/4-D variables. For the sake of simplicity,
1159!--    loop further dimensions to use 2D exchange routines.
1160!--    This should be revised later by introducing new MPI datatypes.
1161       IF ( soil_type_f%from_file  .AND.  ALLOCATED( soil_type_f%var_3d ) )    &
1162       THEN
1163          ALLOCATE( var_dum_int_3d(0:nz_soil,nys:nyn,nxl:nxr) ) 
1164          var_dum_int_3d = soil_type_f%var_3d
1165          DEALLOCATE( soil_type_f%var_3d )
1166          ALLOCATE( soil_type_f%var_3d(0:nz_soil,nysg:nyng,nxlg:nxrg) )
1167          soil_type_f%var_3d = soil_type_f%fill
1168
1169          DO  k = 0, nz_soil
1170             var_exchange_int(nys:nyn,nxl:nxr) = var_dum_int_3d(k,nys:nyn,nxl:nxr)
1171             CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp )
1172             soil_type_f%var_3d(k,:,:) = INT( var_exchange_int(:,:), KIND = 1 )
1173          ENDDO
1174          DEALLOCATE( var_dum_int_3d )
1175       ENDIF
1176
1177       IF ( surface_fraction_f%from_file )  THEN
1178          ALLOCATE( var_dum_real_3d(0:surface_fraction_f%nf-1,nys:nyn,nxl:nxr) )
1179          var_dum_real_3d = surface_fraction_f%frac
1180          DEALLOCATE( surface_fraction_f%frac )
1181          ALLOCATE( surface_fraction_f%frac(0:surface_fraction_f%nf-1,         &
1182                                            nysg:nyng,nxlg:nxrg) )
1183          surface_fraction_f%frac = surface_fraction_f%fill
1184
1185          DO  k = 0, surface_fraction_f%nf-1
1186             var_exchange_real(nys:nyn,nxl:nxr) = var_dum_real_3d(k,nys:nyn,nxl:nxr)
1187             CALL exchange_horiz_2d( var_exchange_real, nbgp )
1188             surface_fraction_f%frac(k,:,:) = var_exchange_real(:,:)
1189          ENDDO
1190          DEALLOCATE( var_dum_real_3d )
1191       ENDIF
1192
1193       IF ( building_pars_f%from_file )  THEN
1194          ALLOCATE( var_dum_real_3d(0:building_pars_f%np-1,nys:nyn,nxl:nxr) )
1195          var_dum_real_3d = building_pars_f%pars_xy
1196          DEALLOCATE( building_pars_f%pars_xy )
1197          ALLOCATE( building_pars_f%pars_xy(0:building_pars_f%np-1,            &
1198                                            nysg:nyng,nxlg:nxrg) )
1199          building_pars_f%pars_xy = building_pars_f%fill
1200          DO  k = 0, building_pars_f%np-1
1201             var_exchange_real(nys:nyn,nxl:nxr) =                              &
1202                                              var_dum_real_3d(k,nys:nyn,nxl:nxr)
1203             CALL exchange_horiz_2d( var_exchange_real, nbgp )
1204             building_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:)
1205          ENDDO
1206          DEALLOCATE( var_dum_real_3d )
1207       ENDIF
1208
1209       IF ( albedo_pars_f%from_file )  THEN
1210          ALLOCATE( var_dum_real_3d(0:albedo_pars_f%np-1,nys:nyn,nxl:nxr) )
1211          var_dum_real_3d = albedo_pars_f%pars_xy
1212          DEALLOCATE( albedo_pars_f%pars_xy )
1213          ALLOCATE( albedo_pars_f%pars_xy(0:albedo_pars_f%np-1,                &
1214                                          nysg:nyng,nxlg:nxrg) )
1215          albedo_pars_f%pars_xy = albedo_pars_f%fill
1216          DO  k = 0, albedo_pars_f%np-1
1217             var_exchange_real(nys:nyn,nxl:nxr) =                              &
1218                                              var_dum_real_3d(k,nys:nyn,nxl:nxr)
1219             CALL exchange_horiz_2d( var_exchange_real, nbgp )
1220             albedo_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:)
1221          ENDDO
1222          DEALLOCATE( var_dum_real_3d )
1223       ENDIF
1224
1225       IF ( pavement_pars_f%from_file )  THEN
1226          ALLOCATE( var_dum_real_3d(0:pavement_pars_f%np-1,nys:nyn,nxl:nxr) )
1227          var_dum_real_3d = pavement_pars_f%pars_xy
1228          DEALLOCATE( pavement_pars_f%pars_xy )
1229          ALLOCATE( pavement_pars_f%pars_xy(0:pavement_pars_f%np-1,            &
1230                                            nysg:nyng,nxlg:nxrg) )
1231          pavement_pars_f%pars_xy = pavement_pars_f%fill
1232          DO  k = 0, pavement_pars_f%np-1
1233             var_exchange_real(nys:nyn,nxl:nxr) =                              &
1234                                              var_dum_real_3d(k,nys:nyn,nxl:nxr)
1235             CALL exchange_horiz_2d( var_exchange_real, nbgp )
1236             pavement_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:)
1237          ENDDO
1238          DEALLOCATE( var_dum_real_3d )
1239       ENDIF
1240
1241       IF ( vegetation_pars_f%from_file )  THEN
1242          ALLOCATE( var_dum_real_3d(0:vegetation_pars_f%np-1,nys:nyn,nxl:nxr) )
1243          var_dum_real_3d = vegetation_pars_f%pars_xy
1244          DEALLOCATE( vegetation_pars_f%pars_xy )
1245          ALLOCATE( vegetation_pars_f%pars_xy(0:vegetation_pars_f%np-1,        &
1246                                            nysg:nyng,nxlg:nxrg) )
1247          vegetation_pars_f%pars_xy = vegetation_pars_f%fill
1248          DO  k = 0, vegetation_pars_f%np-1
1249             var_exchange_real(nys:nyn,nxl:nxr) =                              &
1250                                              var_dum_real_3d(k,nys:nyn,nxl:nxr)
1251             CALL exchange_horiz_2d( var_exchange_real, nbgp )
1252             vegetation_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:)
1253          ENDDO
1254          DEALLOCATE( var_dum_real_3d )
1255       ENDIF
1256
1257       IF ( water_pars_f%from_file )  THEN
1258          ALLOCATE( var_dum_real_3d(0:water_pars_f%np-1,nys:nyn,nxl:nxr) )
1259          var_dum_real_3d = water_pars_f%pars_xy
1260          DEALLOCATE( water_pars_f%pars_xy )
1261          ALLOCATE( water_pars_f%pars_xy(0:water_pars_f%np-1,                  &
1262                                         nysg:nyng,nxlg:nxrg) )
1263          water_pars_f%pars_xy = water_pars_f%fill
1264          DO  k = 0, water_pars_f%np-1
1265             var_exchange_real(nys:nyn,nxl:nxr) =                              &
1266                                              var_dum_real_3d(k,nys:nyn,nxl:nxr)
1267             CALL exchange_horiz_2d( var_exchange_real, nbgp )
1268             water_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:)
1269          ENDDO
1270          DEALLOCATE( var_dum_real_3d )
1271       ENDIF
1272
1273       IF ( root_area_density_lsm_f%from_file )  THEN
1274          ALLOCATE( var_dum_real_3d(0:root_area_density_lsm_f%nz-1,nys:nyn,nxl:nxr) )
1275          var_dum_real_3d = root_area_density_lsm_f%var
1276          DEALLOCATE( root_area_density_lsm_f%var )
1277          ALLOCATE( root_area_density_lsm_f%var(0:root_area_density_lsm_f%nz-1,&
1278                                                nysg:nyng,nxlg:nxrg) )
1279          root_area_density_lsm_f%var = root_area_density_lsm_f%fill
1280
1281          DO  k = 0, root_area_density_lsm_f%nz-1
1282             var_exchange_real(nys:nyn,nxl:nxr) =                              &
1283                                              var_dum_real_3d(k,nys:nyn,nxl:nxr)
1284             CALL exchange_horiz_2d( var_exchange_real, nbgp )
1285             root_area_density_lsm_f%var(k,:,:) = var_exchange_real(:,:)
1286          ENDDO
1287          DEALLOCATE( var_dum_real_3d )
1288       ENDIF
1289
1290       IF ( soil_pars_f%from_file )  THEN
1291          IF ( soil_pars_f%lod == 1 )  THEN
1292
1293             ALLOCATE( var_dum_real_3d(0:soil_pars_f%np-1,nys:nyn,nxl:nxr) )
1294             var_dum_real_3d = soil_pars_f%pars_xy
1295             DEALLOCATE( soil_pars_f%pars_xy )
1296             ALLOCATE( soil_pars_f%pars_xy(0:soil_pars_f%np-1,                 &
1297                                            nysg:nyng,nxlg:nxrg) )
1298             soil_pars_f%pars_xy = soil_pars_f%fill
1299
1300             DO  k = 0, soil_pars_f%np-1
1301                var_exchange_real(nys:nyn,nxl:nxr) =                           &
1302                                              var_dum_real_3d(k,nys:nyn,nxl:nxr)
1303                CALL exchange_horiz_2d( var_exchange_real, nbgp )
1304                soil_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:)
1305             ENDDO
1306             DEALLOCATE( var_dum_real_3d )
1307          ELSEIF ( soil_pars_f%lod == 2 )  THEN
1308             ALLOCATE( var_dum_real_4d(0:soil_pars_f%np-1,                     &
1309                                       0:soil_pars_f%nz-1,                     &
1310                                       nys:nyn,nxl:nxr) )
1311             var_dum_real_4d = soil_pars_f%pars_xyz
1312             DEALLOCATE( soil_pars_f%pars_xyz )
1313             ALLOCATE( soil_pars_f%pars_xyz(0:soil_pars_f%np-1,                &
1314                                            0:soil_pars_f%nz-1,                &
1315                                            nysg:nyng,nxlg:nxrg) )
1316             soil_pars_f%pars_xyz = soil_pars_f%fill
1317
1318             DO  k2 = 0, soil_pars_f%nz-1
1319                DO  k = 0, soil_pars_f%np-1
1320                   var_exchange_real(nys:nyn,nxl:nxr) =                        &
1321                                           var_dum_real_4d(k,k2,nys:nyn,nxl:nxr)
1322                   CALL exchange_horiz_2d( var_exchange_real, nbgp )
1323
1324                   soil_pars_f%pars_xyz(k,k2,:,:) = var_exchange_real(:,:)
1325                ENDDO
1326             ENDDO
1327             DEALLOCATE( var_dum_real_4d )
1328          ENDIF
1329       ENDIF
1330
1331       IF ( pavement_subsurface_pars_f%from_file )  THEN
1332          ALLOCATE( var_dum_real_4d(0:pavement_subsurface_pars_f%np-1,         &
1333                                    0:pavement_subsurface_pars_f%nz-1,         &
1334                                    nys:nyn,nxl:nxr) )
1335          var_dum_real_4d = pavement_subsurface_pars_f%pars_xyz
1336          DEALLOCATE( pavement_subsurface_pars_f%pars_xyz )
1337          ALLOCATE( pavement_subsurface_pars_f%pars_xyz                        &
1338                                          (0:pavement_subsurface_pars_f%np-1,  &
1339                                           0:pavement_subsurface_pars_f%nz-1,  &
1340                                           nysg:nyng,nxlg:nxrg) )
1341          pavement_subsurface_pars_f%pars_xyz = pavement_subsurface_pars_f%fill
1342
1343          DO  k2 = 0, pavement_subsurface_pars_f%nz-1
1344             DO  k = 0, pavement_subsurface_pars_f%np-1
1345                var_exchange_real(nys:nyn,nxl:nxr) =                           &
1346                                          var_dum_real_4d(k,k2,nys:nyn,nxl:nxr)
1347                CALL exchange_horiz_2d( var_exchange_real, nbgp )
1348                pavement_subsurface_pars_f%pars_xyz(k,k2,:,:) =                &
1349                                                        var_exchange_real(:,:)
1350             ENDDO
1351          ENDDO
1352          DEALLOCATE( var_dum_real_4d )
1353       ENDIF
1354
1355!
1356!--    In case of non-cyclic boundary conditions, set Neumann conditions at the
1357!--    lateral boundaries.
1358       IF ( .NOT. bc_ns_cyc )  THEN
1359          IF ( nys == 0  )  THEN
1360             IF ( albedo_type_f%from_file )                                    &
1361                albedo_type_f%var(-1,:) = albedo_type_f%var(0,:)
1362             IF ( pavement_type_f%from_file )                                  &
1363                pavement_type_f%var(-1,:) = pavement_type_f%var(0,:)
1364             IF ( soil_type_f%from_file )  THEN
1365                IF ( ALLOCATED( soil_type_f%var_2d ) )  THEN
1366                   soil_type_f%var_2d(-1,:) = soil_type_f%var_2d(0,:)
1367                ELSE
1368                   soil_type_f%var_3d(:,-1,:) = soil_type_f%var_3d(:,0,:)
1369                ENDIF
1370             ENDIF
1371             IF ( vegetation_type_f%from_file )                                &
1372                vegetation_type_f%var(-1,:) = vegetation_type_f%var(0,:)
1373             IF ( water_type_f%from_file )                                     &
1374                water_type_f%var(-1,:) = water_type_f%var(0,:)
1375             IF ( surface_fraction_f%from_file )                               &
1376                surface_fraction_f%frac(:,-1,:) = surface_fraction_f%frac(:,0,:)
1377             IF ( building_pars_f%from_file )                                  &
1378                building_pars_f%pars_xy(:,-1,:) = building_pars_f%pars_xy(:,0,:)
1379             IF ( albedo_pars_f%from_file )                                    &
1380                albedo_pars_f%pars_xy(:,-1,:) = albedo_pars_f%pars_xy(:,0,:)
1381             IF ( pavement_pars_f%from_file )                                  &
1382                pavement_pars_f%pars_xy(:,-1,:) = pavement_pars_f%pars_xy(:,0,:)
1383             IF ( vegetation_pars_f%from_file )                                &
1384                vegetation_pars_f%pars_xy(:,-1,:) =                            &
1385                                               vegetation_pars_f%pars_xy(:,0,:)
1386             IF ( water_pars_f%from_file )                                     &
1387                water_pars_f%pars_xy(:,-1,:) = water_pars_f%pars_xy(:,0,:)
1388             IF ( root_area_density_lsm_f%from_file )                          &
1389                root_area_density_lsm_f%var(:,-1,:) =                          &
1390                                            root_area_density_lsm_f%var(:,0,:)
1391             IF ( soil_pars_f%from_file )  THEN
1392                IF ( soil_pars_f%lod == 1 )  THEN
1393                   soil_pars_f%pars_xy(:,-1,:) = soil_pars_f%pars_xy(:,0,:)
1394                ELSE
1395                   soil_pars_f%pars_xyz(:,:,-1,:) = soil_pars_f%pars_xyz(:,:,0,:)
1396                ENDIF
1397             ENDIF
1398             IF ( pavement_subsurface_pars_f%from_file )                       &
1399                pavement_subsurface_pars_f%pars_xyz(:,:,-1,:) =                &
1400                                   pavement_subsurface_pars_f%pars_xyz(:,:,0,:)
1401          ENDIF
1402
1403          IF ( nyn == ny )  THEN
1404             IF ( albedo_type_f%from_file )                                    &
1405                albedo_type_f%var(ny+1,:) = albedo_type_f%var(ny,:)
1406             IF ( pavement_type_f%from_file )                                  &
1407                pavement_type_f%var(ny+1,:) = pavement_type_f%var(ny,:)
1408             IF ( soil_type_f%from_file )  THEN
1409                IF ( ALLOCATED( soil_type_f%var_2d ) )  THEN
1410                   soil_type_f%var_2d(ny+1,:) = soil_type_f%var_2d(ny,:)
1411                ELSE
1412                   soil_type_f%var_3d(:,ny+1,:) = soil_type_f%var_3d(:,ny,:)
1413                ENDIF
1414             ENDIF
1415             IF ( vegetation_type_f%from_file )                                &
1416                vegetation_type_f%var(ny+1,:) = vegetation_type_f%var(ny,:)
1417             IF ( water_type_f%from_file )                                     &
1418                water_type_f%var(ny+1,:) = water_type_f%var(ny,:)
1419             IF ( surface_fraction_f%from_file )                               &
1420                surface_fraction_f%frac(:,ny+1,:) =                            &
1421                                             surface_fraction_f%frac(:,ny,:)
1422             IF ( building_pars_f%from_file )                                  &
1423                building_pars_f%pars_xy(:,ny+1,:) =                            &
1424                                             building_pars_f%pars_xy(:,ny,:)
1425             IF ( albedo_pars_f%from_file )                                    &
1426                albedo_pars_f%pars_xy(:,ny+1,:) = albedo_pars_f%pars_xy(:,ny,:)
1427             IF ( pavement_pars_f%from_file )                                  &
1428                pavement_pars_f%pars_xy(:,ny+1,:) =                            &
1429                                             pavement_pars_f%pars_xy(:,ny,:)
1430             IF ( vegetation_pars_f%from_file )                                &
1431                vegetation_pars_f%pars_xy(:,ny+1,:) =                          &
1432                                               vegetation_pars_f%pars_xy(:,ny,:)
1433             IF ( water_pars_f%from_file )                                     &
1434                water_pars_f%pars_xy(:,ny+1,:) = water_pars_f%pars_xy(:,ny,:)
1435             IF ( root_area_density_lsm_f%from_file )                          &
1436                root_area_density_lsm_f%var(:,ny+1,:) =                        &
1437                                            root_area_density_lsm_f%var(:,ny,:)
1438             IF ( soil_pars_f%from_file )  THEN
1439                IF ( soil_pars_f%lod == 1 )  THEN
1440                   soil_pars_f%pars_xy(:,ny+1,:) = soil_pars_f%pars_xy(:,ny,:)
1441                ELSE
1442                   soil_pars_f%pars_xyz(:,:,ny+1,:) =                          &
1443                                              soil_pars_f%pars_xyz(:,:,ny,:)
1444                ENDIF
1445             ENDIF
1446             IF ( pavement_subsurface_pars_f%from_file )                       &
1447                pavement_subsurface_pars_f%pars_xyz(:,:,ny+1,:) =              &
1448                                   pavement_subsurface_pars_f%pars_xyz(:,:,ny,:)
1449          ENDIF
1450       ENDIF
1451
1452       IF ( .NOT. bc_lr_cyc )  THEN
1453          IF ( nxl == 0 )  THEN
1454            IF ( albedo_type_f%from_file )                                     &
1455                albedo_type_f%var(:,-1) = albedo_type_f%var(:,0)
1456             IF ( pavement_type_f%from_file )                                  &
1457                pavement_type_f%var(:,-1) = pavement_type_f%var(:,0)
1458             IF ( soil_type_f%from_file )  THEN
1459                IF ( ALLOCATED( soil_type_f%var_2d ) )  THEN
1460                   soil_type_f%var_2d(:,-1) = soil_type_f%var_2d(:,0)
1461                ELSE
1462                   soil_type_f%var_3d(:,:,-1) = soil_type_f%var_3d(:,:,0)
1463                ENDIF
1464             ENDIF
1465             IF ( vegetation_type_f%from_file )                                &
1466                vegetation_type_f%var(:,-1) = vegetation_type_f%var(:,0)
1467             IF ( water_type_f%from_file )                                     &
1468                water_type_f%var(:,-1) = water_type_f%var(:,0)
1469             IF ( surface_fraction_f%from_file )                               &
1470                surface_fraction_f%frac(:,:,-1) = surface_fraction_f%frac(:,:,0)
1471             IF ( building_pars_f%from_file )                                  &
1472                building_pars_f%pars_xy(:,:,-1) = building_pars_f%pars_xy(:,:,0)
1473             IF ( albedo_pars_f%from_file )                                    &
1474                albedo_pars_f%pars_xy(:,:,-1) = albedo_pars_f%pars_xy(:,:,0)
1475             IF ( pavement_pars_f%from_file )                                  &
1476                pavement_pars_f%pars_xy(:,:,-1) = pavement_pars_f%pars_xy(:,:,0)
1477             IF ( vegetation_pars_f%from_file )                                &
1478                vegetation_pars_f%pars_xy(:,:,-1) =                            &
1479                                               vegetation_pars_f%pars_xy(:,:,0)
1480             IF ( water_pars_f%from_file )                                     &
1481                water_pars_f%pars_xy(:,:,-1) = water_pars_f%pars_xy(:,:,0)
1482             IF ( root_area_density_lsm_f%from_file )                          &
1483                root_area_density_lsm_f%var(:,:,-1) =                          &
1484                                            root_area_density_lsm_f%var(:,:,0)
1485             IF ( soil_pars_f%from_file )  THEN
1486                IF ( soil_pars_f%lod == 1 )  THEN
1487                   soil_pars_f%pars_xy(:,:,-1) = soil_pars_f%pars_xy(:,:,0)
1488                ELSE
1489                   soil_pars_f%pars_xyz(:,:,:,-1) = soil_pars_f%pars_xyz(:,:,:,0)
1490                ENDIF
1491             ENDIF
1492             IF ( pavement_subsurface_pars_f%from_file )                       &
1493                pavement_subsurface_pars_f%pars_xyz(:,:,:,-1) =                &
1494                                    pavement_subsurface_pars_f%pars_xyz(:,:,:,0)
1495          ENDIF
1496
1497          IF ( nxr == nx )  THEN
1498             IF ( albedo_type_f%from_file )                                    &
1499                albedo_type_f%var(:,nx+1) = albedo_type_f%var(:,nx)
1500             IF ( pavement_type_f%from_file )                                  &
1501                pavement_type_f%var(:,nx+1) = pavement_type_f%var(:,nx)
1502             IF ( soil_type_f%from_file )  THEN
1503                IF ( ALLOCATED( soil_type_f%var_2d ) )  THEN
1504                   soil_type_f%var_2d(:,nx+1) = soil_type_f%var_2d(:,nx)
1505                ELSE
1506                   soil_type_f%var_3d(:,:,nx+1) = soil_type_f%var_3d(:,:,nx)
1507                ENDIF
1508             ENDIF
1509             IF ( vegetation_type_f%from_file )                                &
1510                vegetation_type_f%var(:,nx+1) = vegetation_type_f%var(:,nx)
1511             IF ( water_type_f%from_file )                                     &
1512                water_type_f%var(:,nx+1) = water_type_f%var(:,nx)
1513             IF ( surface_fraction_f%from_file )                               &
1514                surface_fraction_f%frac(:,:,nx+1) =                            &
1515                                             surface_fraction_f%frac(:,:,nx)
1516             IF ( building_pars_f%from_file )                                  &
1517                building_pars_f%pars_xy(:,:,nx+1) =                            &
1518                                             building_pars_f%pars_xy(:,:,nx)
1519             IF ( albedo_pars_f%from_file )                                    &
1520                albedo_pars_f%pars_xy(:,:,nx+1) = albedo_pars_f%pars_xy(:,:,nx)
1521             IF ( pavement_pars_f%from_file )                                  &
1522                pavement_pars_f%pars_xy(:,:,nx+1) =                            &
1523                                             pavement_pars_f%pars_xy(:,:,nx)
1524             IF ( vegetation_pars_f%from_file )                                &
1525                vegetation_pars_f%pars_xy(:,:,nx+1) =                          &
1526                                               vegetation_pars_f%pars_xy(:,:,nx)
1527             IF ( water_pars_f%from_file )                                     &
1528                water_pars_f%pars_xy(:,:,nx+1) = water_pars_f%pars_xy(:,:,nx)
1529             IF ( root_area_density_lsm_f%from_file )                          &
1530                root_area_density_lsm_f%var(:,:,nx+1) =                        &
1531                                            root_area_density_lsm_f%var(:,:,nx)
1532             IF ( soil_pars_f%from_file )  THEN
1533                IF ( soil_pars_f%lod == 1 )  THEN
1534                   soil_pars_f%pars_xy(:,:,nx+1) = soil_pars_f%pars_xy(:,:,nx)
1535                ELSE
1536                   soil_pars_f%pars_xyz(:,:,:,nx+1) =                          &
1537                                              soil_pars_f%pars_xyz(:,:,:,nx)
1538                ENDIF
1539             ENDIF
1540             IF ( pavement_subsurface_pars_f%from_file )                       &
1541                pavement_subsurface_pars_f%pars_xyz(:,:,:,nx+1) =              &
1542                                   pavement_subsurface_pars_f%pars_xyz(:,:,:,nx)
1543          ENDIF
1544       ENDIF
1545
1546    END SUBROUTINE netcdf_data_input_surface_data
1547
1548!------------------------------------------------------------------------------!
1549! Description:
1550! ------------
1551!> Reads orography and building information.
1552!------------------------------------------------------------------------------!
1553    SUBROUTINE netcdf_data_input_topo
1554
1555       USE control_parameters,                                                 &
1556           ONLY:  bc_lr_cyc, bc_ns_cyc, message_string, topography
1557
1558       USE indices,                                                            &
1559           ONLY:  nbgp, nx, nxl, nxr, ny, nyn, nys, nzb, nzt
1560                 
1561
1562       IMPLICIT NONE
1563
1564       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names  !< variable names in static input file
1565
1566
1567       INTEGER(iwp) ::  i             !< running index along x-direction
1568       INTEGER(iwp) ::  ii            !< running index for IO blocks
1569       INTEGER(iwp) ::  id_topo       !< NetCDF id of topograhy input file
1570       INTEGER(iwp) ::  j             !< running index along y-direction
1571       INTEGER(iwp) ::  k             !< running index along z-direction
1572       INTEGER(iwp) ::  num_vars      !< number of variables in netcdf input file
1573       INTEGER(iwp) ::  skip_n_rows   !< counting variable to skip rows while reading topography file
1574
1575       INTEGER(iwp), DIMENSION(nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) ::  var_exchange_int !< dummy variables used to exchange 32-bit Integer arrays
1576
1577       REAL(wp) ::  dum           !< dummy variable to skip columns while reading topography file   
1578
1579       IF ( TRIM( topography ) /= 'read_from_file' )  RETURN
1580
1581       DO  ii = 0, io_blocks-1
1582          IF ( ii == io_group )  THEN
1583#if defined ( __netcdf )
1584!
1585!--          Input via palm-input data standard
1586             IF ( input_pids_static )  THEN
1587!
1588!--             Open file in read-only mode
1589                CALL open_read_file( TRIM( input_file_static ) //              &
1590                                     TRIM( coupling_char ), id_topo ) 
1591
1592!
1593!--             At first, inquire all variable names.
1594!--             This will be used to check whether an  input variable exist
1595!--             or not.
1596                CALL inquire_num_variables( id_topo, num_vars )
1597!
1598!--             Allocate memory to store variable names and inquire them.
1599                ALLOCATE( var_names(1:num_vars) )
1600                CALL inquire_variable_names( id_topo, var_names )
1601!
1602!--             Terrain height. First, get variable-related _FillValue attribute
1603                IF ( check_existence( var_names, 'orography_2D' ) )  THEN
1604                   terrain_height_f%from_file = .TRUE. 
1605                   CALL get_attribute( id_topo, char_fill,                     &
1606                                       terrain_height_f%fill,                  &
1607                                       .FALSE., 'orography_2D' ) 
1608!
1609!--                PE-wise reading of 2D terrain height.
1610                   ALLOCATE ( terrain_height_f%var(nys:nyn,nxl:nxr)  )
1611                   DO  i = nxl, nxr
1612                      CALL get_variable( id_topo, 'orography_2D',              &
1613                                         i, terrain_height_f%var(:,i) ) 
1614                   ENDDO
1615                ELSE
1616                   terrain_height_f%from_file = .FALSE. 
1617                ENDIF
1618
1619!
1620!--             Read building height. First, read its _FillValue attribute,
1621!--             as well as lod attribute
1622                buildings_f%from_file = .FALSE. 
1623                IF ( check_existence( var_names, 'buildings_2D' ) )  THEN
1624                   buildings_f%from_file = .TRUE. 
1625                   CALL get_attribute( id_topo, char_lod, buildings_f%lod,     &
1626                                       .FALSE., 'buildings_2D' )     
1627
1628                   CALL get_attribute( id_topo, char_fill,                     &
1629                                       buildings_f%fill1,                      &
1630                                       .FALSE., 'buildings_2D' )
1631
1632!
1633!--                Read 2D topography
1634                   IF ( buildings_f%lod == 1 )  THEN
1635                      ALLOCATE ( buildings_f%var_2d(nys:nyn,nxl:nxr) )
1636                      DO  i = nxl, nxr
1637                         CALL get_variable( id_topo, 'buildings_2D',           &
1638                                            i, buildings_f%var_2d(:,i) ) 
1639                      ENDDO
1640                   ELSE
1641                      message_string = 'NetCDF attribute lod ' //              &
1642                                       '(level of detail) is not set properly.'
1643                      CALL message( 'netcdf_data_input_mod', 'PA0999',         &
1644                                     1, 2, 0, 6, 0 )
1645                   ENDIF
1646                ENDIF
1647!
1648!--             If available, also read 3D building information. If both are
1649!--             available, use 3D information.
1650!                 IF ( check_existence( var_names, 'buildings_3D' ) )  THEN
1651!                    buildings_f%from_file = .TRUE.
1652!                    CALL get_attribute( id_topo, char_lod, buildings_f%lod,     &
1653!                                        .FALSE., 'buildings_3D' )     
1654!
1655!                    CALL get_attribute( id_topo, char_fill,                     &
1656!                                        buildings_f%fill2,                      &
1657!                                        .FALSE., 'buildings_3D' )
1658!
1659!                    CALL get_dimension_length( id_topo, buildings_f%nz, 'z' )
1660
1661!                    IF ( buildings_f%lod == 2 )  THEN
1662!                       ALLOCATE( buildings_f%var_3d(nzb:buildings_f%nz,         &
1663!                                                    nys:nyn,nxl:nxr) )
1664!                       buildings_f%var_3d = 0
1665! !
1666! !--                   Read data PE-wise. Read yz-slices.
1667!                       DO  i = nxl, nxr
1668!                          DO  j = nys, nyn
1669!                             CALL get_variable( id_topo, 'buildings_3D',        &
1670!                                                i, j,                           &
1671!                                                buildings_f%var_3d(:,j,i) )
1672!                          ENDDO
1673!                       ENDDO
1674!                    ELSE
1675!                       message_string = 'NetCDF attribute lod ' //              &
1676!                                        '(level of detail) is not set properly.'
1677!                       CALL message( 'netcdf_data_input_mod', 'PA0999',         &
1678!                                      1, 2, 0, 6, 0 )
1679!                    ENDIF
1680!                 ENDIF
1681!
1682!--             Read building IDs and its FillValue attribute. Further required
1683!--             for mapping buildings on top of orography.
1684                IF ( check_existence( var_names, 'building_id' ) )  THEN
1685                   building_id_f%from_file = .TRUE. 
1686                   CALL get_attribute( id_topo, char_fill,                     &
1687                                       building_id_f%fill, .FALSE.,            &
1688                                       'building_id' )
1689             
1690
1691                   ALLOCATE ( building_id_f%var(nys:nyn,nxl:nxr) )
1692                   DO  i = nxl, nxr
1693                      CALL get_variable( id_topo, 'building_id',               &
1694                                          i, building_id_f%var(:,i) ) 
1695                   ENDDO
1696                ELSE
1697                   building_id_f%from_file = .FALSE. 
1698                ENDIF
1699!
1700!--             Read building_type and required attributes.
1701                IF ( check_existence( var_names, 'building_type' ) )  THEN
1702                   building_type_f%from_file = .TRUE. 
1703                   CALL get_attribute( id_topo, char_fill,                     &
1704                                       building_type_f%fill, .FALSE.,          &
1705                                       'building_type' ) 
1706               
1707                   ALLOCATE ( building_type_f%var(nys:nyn,nxl:nxr) )
1708                   DO  i = nxl, nxr
1709                      CALL get_variable( id_topo, 'building_type',             &
1710                                         i, building_type_f%var(:,i) )
1711                   ENDDO
1712                ELSE
1713                   building_type_f%from_file = .FALSE.
1714                ENDIF
1715
1716!
1717!--             Close topography input file
1718                CALL close_input_file( id_topo )
1719#endif
1720!
1721!--          ASCII input
1722             ELSE
1723
1724                OPEN( 90, FILE='TOPOGRAPHY_DATA'//TRIM( coupling_char ),       &
1725                      STATUS='OLD', FORM='FORMATTED', ERR=10 )
1726!
1727!--             Read topography PE-wise. Rows are read from nyn to nys, columns
1728!--             are read from nxl to nxr. At first, ny-nyn rows need to be skipped.
1729                skip_n_rows = 0
1730                DO WHILE ( skip_n_rows < ny - nyn )
1731                   READ( 90, * ) 
1732                   skip_n_rows = skip_n_rows + 1
1733                ENDDO
1734!
1735!--             Read data from nyn to nys and nxl to nxr. Therefore, skip
1736!--             column until nxl-1 is reached
1737                ALLOCATE ( buildings_f%var_2d(nys:nyn,nxl:nxr) )
1738                DO  j = nyn, nys, -1
1739                   READ( 90, *, ERR=11, END=11 )                               &
1740                                   ( dum, i = 0, nxl-1 ),                      &
1741                                   ( buildings_f%var_2d(j,i), i = nxl, nxr )
1742                ENDDO
1743
1744                GOTO 12
1745         
1746 10             message_string = 'file TOPOGRAPHY'//TRIM( coupling_char )//    &
1747                                 ' does not exist'
1748                CALL message( 'netcdf_data_input_mod', 'PA0208', 1, 2, 0, 6, 0 )
1749
1750 11             message_string = 'errors in file TOPOGRAPHY_DATA'//            &
1751                                 TRIM( coupling_char )
1752                CALL message( 'netcdf_data_input_mod', 'PA0209', 1, 2, 0, 6, 0 )
1753
1754 12             CLOSE( 90 )
1755                buildings_f%from_file = .TRUE.
1756
1757             ENDIF
1758
1759          ENDIF
1760#if defined( __parallel )
1761          CALL MPI_BARRIER( comm2d, ierr )
1762#endif
1763       ENDDO
1764!
1765!--    Check for minimum requirement of topography data in case
1766!--    static input file is used. Note, doing this check in check_parameters
1767!--    will be too late (data will be used for grid inititialization before).
1768       IF ( input_pids_static )  THEN
1769          IF ( .NOT. terrain_height_f%from_file  .OR.                          &
1770               .NOT. building_id_f%from_file     .OR.                          &
1771               .NOT. buildings_f%from_file )  THEN                       
1772             message_string = 'Minimum requirement for topography input ' //   &
1773                              'is not fulfilled. ' //                          &
1774                              'Orography, buildings, as well as building ' //  &
1775                              'IDs are required.'
1776             CALL message( 'netcdf_data_input_mod', 'PA0999', 1, 2, 0, 6, 0 )
1777          ENDIF
1778       ENDIF
1779!
1780!--    Finally, exchange 1 ghost point for building ID and type.
1781!--    In case of non-cyclic boundary conditions set Neumann conditions at the
1782!--    lateral boundaries.
1783       IF ( building_id_f%from_file )  THEN
1784          var_exchange_int                  = building_id_f%fill
1785          var_exchange_int(nys:nyn,nxl:nxr) = building_id_f%var(nys:nyn,nxl:nxr)
1786          CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp )
1787          DEALLOCATE( building_id_f%var )
1788          ALLOCATE( building_id_f%var(nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
1789          building_id_f%var = var_exchange_int
1790
1791          IF ( .NOT. bc_ns_cyc )  THEN
1792             IF ( nys == 0  )  building_id_f%var(-1,:)   = building_id_f%var(0,:)
1793             IF ( nyn == ny )  building_id_f%var(ny+1,:) = building_id_f%var(ny,:)
1794          ENDIF
1795          IF ( .NOT. bc_lr_cyc )  THEN
1796             IF ( nxl == 0  )  building_id_f%var(:,-1)   = building_id_f%var(:,0) 
1797             IF ( nxr == nx )  building_id_f%var(:,nx+1) = building_id_f%var(:,nx)       
1798          ENDIF
1799       ENDIF
1800
1801       IF ( building_type_f%from_file )  THEN
1802          var_exchange_int                  = INT( building_type_f%fill, KIND = 4 )
1803          var_exchange_int(nys:nyn,nxl:nxr) =                                  &
1804                          INT( building_type_f%var(nys:nyn,nxl:nxr), KIND = 4 )
1805          CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp )
1806          DEALLOCATE( building_type_f%var )
1807          ALLOCATE( building_type_f%var(nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
1808          building_type_f%var = INT( var_exchange_int, KIND = 1 )
1809
1810          IF ( .NOT. bc_ns_cyc )  THEN
1811             IF ( nys == 0  )  building_type_f%var(-1,:)   = building_type_f%var(0,:)
1812             IF ( nyn == ny )  building_type_f%var(ny+1,:) = building_type_f%var(ny,:)
1813          ENDIF
1814          IF ( .NOT. bc_lr_cyc )  THEN
1815             IF ( nxl == 0  )  building_type_f%var(:,-1)   = building_type_f%var(:,0) 
1816             IF ( nxr == nx )  building_type_f%var(:,nx+1) = building_type_f%var(:,nx)       
1817          ENDIF
1818       ENDIF
1819
1820    END SUBROUTINE netcdf_data_input_topo
1821
1822!------------------------------------------------------------------------------!
1823! Description:
1824! ------------
1825!> Reads initialization data of u, v, w, pt, q, geostrophic wind components,
1826!> as well as soil moisture and soil temperature, derived from larger-scale
1827!> model (COSMO) by Inifor.
1828!------------------------------------------------------------------------------!
1829    SUBROUTINE netcdf_data_input_init_3d
1830
1831       USE arrays_3d,                                                          &
1832           ONLY:  q, pt, u, v, w
1833
1834       USE control_parameters,                                                 &
1835           ONLY:  bc_lr_cyc, bc_ns_cyc, forcing, humidity, message_string,     &
1836                  neutral, surface_pressure
1837
1838       USE indices,                                                            &
1839           ONLY:  nx, nxl, nxlu, nxr, ny, nyn, nys, nysv, nzb, nzt
1840
1841       IMPLICIT NONE
1842
1843       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names
1844
1845       INTEGER(iwp) ::  i          !< running index along x-direction
1846       INTEGER(iwp) ::  ii         !< running index for IO blocks
1847       INTEGER(iwp) ::  id_dynamic !< NetCDF id of dynamic input file
1848       INTEGER(iwp) ::  j          !< running index along y-direction
1849       INTEGER(iwp) ::  k          !< running index along z-direction
1850       INTEGER(iwp) ::  num_vars   !< number of variables in netcdf input file
1851       INTEGER(iwp) ::  off_i      !< offset in x-direction used for reading the u-component
1852       INTEGER(iwp) ::  off_j      !< offset in y-direction used for reading the v-component
1853
1854!
1855!--    Skip routine if no input file with dynamic input data is available.
1856       IF ( .NOT. input_pids_dynamic )  RETURN
1857!
1858!--    Please note, Inifor is designed to provide initial data for u and v for
1859!--    the prognostic grid points in case of lateral Dirichlet conditions.
1860!--    This means that Inifor provides data from nxlu:nxr (for u) and
1861!--    from nysv:nyn (for v) at the left and south domain boundary, respectively.
1862!--    However, as work-around for the moment, PALM will run with cyclic
1863!--    conditions and will be initialized with data provided by Inifor
1864!--    boundaries in case of Dirichlet.
1865!--    Hence, simply set set nxlu/nysv to 1 (will be reset to its original value
1866!--    at the end of this routine.
1867       IF ( bc_lr_cyc  .AND.  nxl == 0 )  nxlu = 1 
1868       IF ( bc_ns_cyc  .AND.  nys == 0 )  nysv = 1
1869
1870       DO  ii = 0, io_blocks-1
1871          IF ( ii == io_group )  THEN
1872#if defined ( __netcdf )
1873!
1874!--          Open file in read-only mode
1875             CALL open_read_file( TRIM( input_file_dynamic ) //                &
1876                                  TRIM( coupling_char ), id_dynamic ) 
1877
1878!
1879!--          At first, inquire all variable names.
1880             CALL inquire_num_variables( id_dynamic, num_vars )
1881!
1882!--          Allocate memory to store variable names.
1883             ALLOCATE( var_names(1:num_vars) )
1884             CALL inquire_variable_names( id_dynamic, var_names )
1885!
1886!--          Read vertical dimension of scalar und w grid. Will be used for
1887!--          inter- and extrapolation in case of stretched numeric grid.
1888!--          This will be removed when Inifor is able to handle stretched grids.
1889             CALL get_dimension_length( id_dynamic, init_3d%nzu, 'z'     )
1890             CALL get_dimension_length( id_dynamic, init_3d%nzw, 'zw'    )
1891             CALL get_dimension_length( id_dynamic, init_3d%nzs, 'depth' )
1892!
1893!--          Read also the horizontal dimensions. These are used just used fo
1894!--          checking the compatibility with the PALM grid before reading.
1895             CALL get_dimension_length( id_dynamic, init_3d%nx,  'x'  )
1896             CALL get_dimension_length( id_dynamic, init_3d%nxu, 'xu' )
1897             CALL get_dimension_length( id_dynamic, init_3d%ny,  'y'  )
1898             CALL get_dimension_length( id_dynamic, init_3d%nyv, 'yv' )
1899!
1900!--          Check for correct horizontal dimension. Please note, u- and v-grid
1901!--          hase 1 grid point less on Inifor grid.
1902             IF ( init_3d%nx-1 /= nx  .OR.  init_3d%nxu-1 /= nx - 1  .OR.      &
1903                  init_3d%ny-1 /= ny  .OR.  init_3d%nyv-1 /= ny - 1 )  THEN
1904                message_string = 'Number of inifor grid points does not '  //  &
1905                                 'match the number of numeric grid points.'
1906                CALL message( 'netcdf_data_input_mod', 'PA0999', 1, 2, 0, 6, 0 )
1907             ENDIF
1908!
1909!--          Read vertical dimensions. Later, these are required for eventual
1910!--          inter- and extrapolations of the initialization data.
1911             IF ( check_existence( var_names, 'z' ) )  THEN
1912                ALLOCATE( init_3d%zu_atmos(1:init_3d%nzu) )
1913                CALL get_variable( id_dynamic, 'z', init_3d%zu_atmos )
1914             ENDIF
1915             IF ( check_existence( var_names, 'zw' ) )  THEN
1916                ALLOCATE( init_3d%zw_atmos(1:init_3d%nzw) )
1917                CALL get_variable( id_dynamic, 'zw', init_3d%zw_atmos )
1918             ENDIF
1919             IF ( check_existence( var_names, 'depth' ) )  THEN
1920                ALLOCATE( init_3d%z_soil(1:init_3d%nzs) )
1921                CALL get_variable( id_dynamic, 'depth', init_3d%z_soil )
1922             ENDIF
1923!
1924!--          Read geostrophic wind components
1925!              IF ( check_existence( var_names, 'ls_forcing_ug' ) )  THEN
1926!
1927!              ENDIF
1928!              IF ( check_existence( var_names, 'ls_forcing_vg' ) )  THEN
1929!
1930!              ENDIF
1931
1932!
1933!--          Read inital 3D data of u, v, w, pt and q,
1934!--          derived from COSMO model. Read PE-wise yz-slices.
1935!--          Please note, the u-, v- and w-component are defined on different
1936!--          grids with one element less in the x-, y-,
1937!--          and z-direction, respectively. Hence, reading is subdivided
1938!--          into separate loops. Moreover, i and j are used
1939!--          as start index in the NF90 interface.
1940!--          The passed arguments for u, and v are (i,j)-1, respectively,
1941!--          in contrast to the remaining quantities. This is because in case
1942!--          of forcing is applied, the input data for u and v has one
1943!--          element less along the x- and y-direction respectively.
1944!--          Read u-component
1945             IF ( check_existence( var_names, 'init_u' ) )  THEN
1946!
1947!--             Read attributes for the fill value and level-of-detail
1948                CALL get_attribute( id_dynamic, char_fill, init_3d%fill_u,     &
1949                                    .FALSE., 'init_u' )
1950                CALL get_attribute( id_dynamic, char_lod, init_3d%lod_u,       &
1951                                    .FALSE., 'init_u' )
1952!
1953!--             level-of-detail 1 - read initialization profile
1954                IF ( init_3d%lod_u == 1 )  THEN
1955                   ALLOCATE( init_3d%u_init(nzb:nzt+1) )
1956                   init_3d%u_init = 0.0_wp
1957
1958                   CALL get_variable( id_dynamic, 'init_u',                    &
1959                                      init_3d%u_init(nzb+1:nzt+1) )
1960!
1961!--             level-of-detail 2 - read 3D initialization data
1962                ELSEIF ( init_3d%lod_u == 2 )  THEN
1963!
1964!--                Set offset value. In case of Dirichlet conditions at the left
1965!--                domain boundary, the u component starts at nxl+1. This case,
1966!--                the passed start-index for reading the NetCDF data is shifted
1967!--                by -1. 
1968                   off_i = 1 !MERGE( 1, 0, forcing )
1969
1970                   DO  i = nxlu, nxr
1971                      DO  j = nys, nyn   
1972                         CALL get_variable( id_dynamic, 'init_u', i-off_i, j,  &
1973                                            u(nzb+1:nzt+1,j,i) )
1974                      ENDDO
1975                   ENDDO
1976
1977                ENDIF
1978                init_3d%from_file_u = .TRUE.
1979             ENDIF
1980!
1981!--          Read v-component
1982             IF ( check_existence( var_names, 'init_v' ) )  THEN
1983!
1984!--             Read attributes for the fill value and level-of-detail
1985                CALL get_attribute( id_dynamic, char_fill, init_3d%fill_v,     &
1986                                    .FALSE., 'init_v' )
1987                CALL get_attribute( id_dynamic, char_lod, init_3d%lod_v,       &
1988                                    .FALSE., 'init_v' )
1989!
1990!--             level-of-detail 1 - read initialization profile
1991                IF ( init_3d%lod_v == 1 )  THEN
1992                   ALLOCATE( init_3d%v_init(nzb:nzt+1) )
1993                   init_3d%v_init = 0.0_wp
1994
1995                   CALL get_variable( id_dynamic, 'init_v',                    &
1996                                      init_3d%v_init(nzb+1:nzt+1) )
1997
1998!
1999!--             level-of-detail 2 - read 3D initialization data
2000                ELSEIF ( init_3d%lod_v == 2 )  THEN
2001!
2002!--                Set offset value. In case of Dirichlet conditions at the south
2003!--                domain boundary, the v component starts at nys+1. This case,
2004!--                the passed start-index for reading the NetCDF data is shifted
2005!--                by -1. 
2006                   off_j = 1 !MERGE( 1, 0, forcing )
2007
2008                   DO  i = nxl, nxr
2009                      DO  j = nysv, nyn   
2010                         CALL get_variable( id_dynamic, 'init_v', i, j-off_j,  &
2011                                            v(nzb+1:nzt+1,j,i) )
2012                      ENDDO
2013                   ENDDO
2014
2015                ENDIF
2016                init_3d%from_file_v = .TRUE.
2017             ENDIF
2018!
2019!--          Read w-component
2020             IF ( check_existence( var_names, 'init_w' ) )  THEN
2021!
2022!--             Read attributes for the fill value and level-of-detail
2023                CALL get_attribute( id_dynamic, char_fill, init_3d%fill_w,     &
2024                                    .FALSE., 'init_w' )
2025                CALL get_attribute( id_dynamic, char_lod, init_3d%lod_w,       &
2026                                    .FALSE., 'init_w' )
2027!
2028!--             level-of-detail 1 - read initialization profile
2029                IF ( init_3d%lod_w == 1 )  THEN
2030                   ALLOCATE( init_3d%w_init(nzb:nzt+1) )
2031                   init_3d%w_init = 0.0_wp
2032
2033                   CALL get_variable( id_dynamic, 'init_w',                    &
2034                                      init_3d%w_init(nzb+1:nzt) )
2035
2036!
2037!--             level-of-detail 2 - read 3D initialization data
2038                ELSEIF ( init_3d%lod_w == 2 )  THEN
2039                   DO  i = nxl, nxr
2040                      DO  j = nys, nyn
2041                         CALL get_variable( id_dynamic, 'init_w', i, j,        &
2042                                            w(nzb+1:nzt,j,i) )
2043                      ENDDO
2044                   ENDDO
2045
2046                ENDIF
2047                init_3d%from_file_w = .TRUE.
2048             ENDIF
2049!
2050!--          Read potential temperature
2051             IF ( .NOT. neutral )  THEN     
2052                IF ( check_existence( var_names, 'init_pt' ) )  THEN   
2053!
2054!--                Read attributes for the fill value and level-of-detail
2055                   CALL get_attribute( id_dynamic, char_fill, init_3d%fill_pt, &
2056                                       .FALSE., 'init_pt' )
2057                   CALL get_attribute( id_dynamic, char_lod, init_3d%lod_pt,   &
2058                                       .FALSE., 'init_pt' )
2059!
2060!--                level-of-detail 1 - read initialization profile
2061                   IF ( init_3d%lod_pt == 1 )  THEN
2062                      ALLOCATE( init_3d%pt_init(nzb:nzt+1) )
2063
2064                      CALL get_variable( id_dynamic, 'init_pt',                &
2065                                         init_3d%pt_init(nzb+1:nzt+1) )
2066!
2067!--                   Set Neumann surface boundary condition for initial profil
2068                      init_3d%pt_init(nzb) = init_3d%pt_init(nzb+1)
2069!
2070!--                level-of-detail 2 - read 3D initialization data
2071                   ELSEIF ( init_3d%lod_pt == 2 )  THEN
2072                      DO  i = nxl, nxr
2073                         DO  j = nys, nyn
2074                            CALL get_variable( id_dynamic, 'init_pt', i, j,    &
2075                                               pt(nzb+1:nzt+1,j,i) )
2076                         ENDDO
2077                      ENDDO
2078
2079                   ENDIF
2080                   init_3d%from_file_pt = .TRUE.
2081                ENDIF
2082             ENDIF
2083!
2084!--          Read mixing ratio
2085             IF ( humidity )  THEN
2086                IF ( check_existence( var_names, 'init_qv' ) )  THEN
2087!
2088!--                Read attributes for the fill value and level-of-detail
2089                   CALL get_attribute( id_dynamic, char_fill, init_3d%fill_q,  &
2090                                       .FALSE., 'init_qv' )
2091                   CALL get_attribute( id_dynamic, char_lod, init_3d%lod_q,    &
2092                                       .FALSE., 'init_qv' )
2093!
2094!--                level-of-detail 1 - read initialization profile
2095                   IF ( init_3d%lod_q == 1 )  THEN
2096                      ALLOCATE( init_3d%q_init(nzb:nzt+1) )
2097
2098                      CALL get_variable( id_dynamic, 'init_qv',               &
2099                                         init_3d%q_init(nzb+1:nzt+1) )
2100!
2101!--                   Set Neumann surface boundary condition for initial profil
2102                      init_3d%q_init(nzb) = init_3d%q_init(nzb+1)
2103
2104!
2105!--                level-of-detail 2 - read 3D initialization data
2106                   ELSEIF ( init_3d%lod_q == 2 )  THEN
2107                      DO  i = nxl, nxr
2108                         DO  j = nys, nyn
2109                            CALL get_variable( id_dynamic, 'init_qv', i, j,    &
2110                                               q(nzb+1:nzt+1,j,i) )
2111                         ENDDO
2112                      ENDDO
2113
2114                   ENDIF
2115                   init_3d%from_file_q = .TRUE.
2116                ENDIF
2117             ENDIF
2118!
2119!--          Read soil moisture
2120             IF ( check_existence( var_names, 'init_soil_m' ) )  THEN
2121!
2122!--             Read attributes for the fill value and level-of-detail
2123                CALL get_attribute( id_dynamic, char_fill, init_3d%fill_msoil, &
2124                                    .FALSE., 'init_soil_m' )
2125                CALL get_attribute( id_dynamic, char_lod, init_3d%lod_msoil,   &
2126                                    .FALSE., 'init_soil_m' )
2127!
2128!--             level-of-detail 1 - read initialization profile
2129                IF ( init_3d%lod_msoil == 1 )  THEN
2130                   ALLOCATE( init_3d%msoil_init(0:init_3d%nzs-1) )
2131
2132                   CALL get_variable( id_dynamic, 'init_soil_m',               &
2133                                      init_3d%msoil_init(0:init_3d%nzs-1) )
2134!
2135!--             level-of-detail 2 - read 3D initialization data
2136                ELSEIF ( init_3d%lod_msoil == 2 )  THEN  ! need to be corrected
2137                   ALLOCATE ( init_3d%msoil(0:init_3d%nzs-1,nys:nyn,nxl:nxr) )
2138                   DO  i = nxl, nxr
2139                      DO  j = nys, nyn
2140                         CALL get_variable( id_dynamic, 'init_soil_m', i, j,   &
2141                                            init_3d%msoil(0:init_3d%nzs-1,j,i) )
2142                      ENDDO
2143                   ENDDO
2144                ENDIF
2145                init_3d%from_file_msoil = .TRUE.
2146             ENDIF
2147!
2148!--          Read soil temperature
2149             IF ( check_existence( var_names, 'init_soil_t' ) )  THEN
2150!
2151!--             Read attributes for the fill value and level-of-detail
2152                CALL get_attribute( id_dynamic, char_fill, init_3d%fill_tsoil, &
2153                                    .FALSE., 'init_soil_t' )
2154                CALL get_attribute( id_dynamic, char_lod, init_3d%lod_tsoil,   &
2155                                    .FALSE., 'init_soil_t' )
2156!
2157!--             level-of-detail 1 - read initialization profile
2158                IF ( init_3d%lod_tsoil == 1 )  THEN
2159                   ALLOCATE( init_3d%tsoil_init(0:init_3d%nzs-1) )
2160
2161                   CALL get_variable( id_dynamic, 'init_soil_t',               &
2162                                      init_3d%tsoil_init(0:init_3d%nzs-1) )
2163
2164!
2165!--             level-of-detail 2 - read 3D initialization data
2166                ELSEIF ( init_3d%lod_tsoil == 2 )  THEN  ! need to be corrected
2167                   ALLOCATE ( init_3d%tsoil(0:init_3d%nzs-1,nys:nyn,nxl:nxr) )
2168                   DO  i = nxl, nxr
2169                      DO  j = nys, nyn
2170                         CALL get_variable( id_dynamic, 'init_soil_t', i, j,   &
2171                                            init_3d%tsoil(0:init_3d%nzs-1,j,i) )
2172                      ENDDO
2173                   ENDDO
2174                ENDIF
2175                init_3d%from_file_tsoil = .TRUE.
2176             ENDIF
2177!
2178!--          Close input file
2179             CALL close_input_file( id_dynamic )
2180#endif
2181          ENDIF
2182#if defined( __parallel )
2183          CALL MPI_BARRIER( comm2d, ierr )
2184#endif
2185       ENDDO
2186!
2187!--    Finally, check if the input data has any fill values.
2188       IF ( init_3d%from_file_u )  THEN
2189          IF ( ANY( u(nzb+1:nzt+1,nys:nyn,nxlu:nxr) == init_3d%fill_u ) )  THEN
2190             message_string = 'NetCDF input for u_init must not contain ' //   &
2191                              'any _FillValues'
2192             CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )
2193          ENDIF
2194       ENDIF
2195       IF ( init_3d%from_file_v )  THEN
2196          IF ( ANY( v(nzb+1:nzt+1,nysv:nyn,nxl:nxr) == init_3d%fill_v ) )  THEN
2197             message_string = 'NetCDF input for v_init must not contain ' //   &
2198                              'any _FillValues'
2199             CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )
2200          ENDIF
2201       ENDIF
2202       IF ( init_3d%from_file_w )  THEN
2203          IF ( ANY( w(nzb+1:nzt,nys:nyn,nxl:nxr) == init_3d%fill_w ) )  THEN
2204             message_string = 'NetCDF input for w_init must not contain ' //   &
2205                              'any _FillValues'
2206             CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )
2207          ENDIF
2208       ENDIF
2209       IF ( init_3d%from_file_pt )  THEN
2210          IF ( ANY( pt(nzb+1:nzt+1,nys:nyn,nxl:nxr) == init_3d%fill_pt ) )  THEN
2211             message_string = 'NetCDF input for pt_init must not contain ' //  &
2212                              'any _FillValues'
2213             CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )
2214          ENDIF
2215       ENDIF
2216       IF ( init_3d%from_file_q )  THEN
2217          IF ( ANY( q(nzb+1:nzt+1,nys:nyn,nxl:nxr) == init_3d%fill_q ) )  THEN
2218             message_string = 'NetCDF input for q_init must not contain ' //   &
2219                              'any _FillValues'
2220             CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )
2221          ENDIF
2222       ENDIF
2223!
2224!--    Workaround for cyclic conditions. Please see above for further explanation.
2225       IF ( bc_lr_cyc  .AND.  nxl == 0 )  nxlu = nxl 
2226       IF ( bc_ns_cyc  .AND.  nys == 0 )  nysv = nys
2227
2228    END SUBROUTINE netcdf_data_input_init_3d
2229
2230!------------------------------------------------------------------------------!
2231! Description:
2232! ------------
2233!> Reads data at lateral and top boundaries derived from larger-scale model
2234!> (COSMO) by Inifor.
2235!------------------------------------------------------------------------------!
2236    SUBROUTINE netcdf_data_input_lsf
2237
2238       USE control_parameters,                                                 &
2239           ONLY:  force_bound_l, force_bound_n, force_bound_r, force_bound_s,  &
2240                  forcing, humidity, message_string, neutral, simulated_time
2241
2242       USE indices,                                                            &
2243           ONLY:  nx, nxl, nxlu, nxr, ny, nyn, nys, nysv, nzb, nzt
2244
2245       IMPLICIT NONE
2246
2247
2248       INTEGER(iwp) ::  i          !< running index along x-direction
2249       INTEGER(iwp) ::  ii         !< running index for IO blocks
2250       INTEGER(iwp) ::  id_dynamic !< NetCDF id of dynamic input file
2251       INTEGER(iwp) ::  j          !< running index along y-direction
2252       INTEGER(iwp) ::  k          !< running index along z-direction
2253       INTEGER(iwp) ::  num_vars   !< number of variables in netcdf input file
2254       INTEGER(iwp) ::  t          !< running index time dimension
2255
2256       REAL(wp) ::  dum           !< dummy variable to skip columns while reading topography file   
2257
2258       force%from_file = MERGE( .TRUE., .FALSE., input_pids_dynamic ) 
2259!
2260!--    Skip input if no forcing from larger-scale models is applied.
2261       IF ( .NOT. forcing )  RETURN
2262
2263       DO  ii = 0, io_blocks-1
2264          IF ( ii == io_group )  THEN
2265#if defined ( __netcdf )
2266!
2267!--          Open file in read-only mode
2268             CALL open_read_file( TRIM( input_file_dynamic ) //                &
2269                                  TRIM( coupling_char ), id_dynamic ) 
2270!
2271!--          Initialize INIFOR forcing.
2272             IF ( .NOT. force%init )  THEN
2273!
2274!--             At first, inquire all variable names.
2275                CALL inquire_num_variables( id_dynamic, num_vars )
2276!
2277!--             Allocate memory to store variable names.
2278                ALLOCATE( force%var_names(1:num_vars) )
2279                CALL inquire_variable_names( id_dynamic, force%var_names )
2280!
2281!--             Read time dimension, allocate memory and finally read time array
2282                CALL get_dimension_length( id_dynamic, force%nt, 'time' )
2283
2284                IF ( check_existence( force%var_names, 'time' ) )  THEN
2285                   ALLOCATE( force%time(0:force%nt-1) )
2286                   CALL get_variable( id_dynamic, 'time', force%time )
2287                ENDIF
2288!
2289!--             Read vertical dimension of scalar und w grid
2290                CALL get_dimension_length( id_dynamic, force%nzu, 'z' )
2291                CALL get_dimension_length( id_dynamic, force%nzw, 'zw' )
2292
2293                IF ( check_existence( force%var_names, 'z' ) )  THEN
2294                   ALLOCATE( force%zu_atmos(1:force%nzu) )
2295                   CALL get_variable( id_dynamic, 'z', force%zu_atmos )
2296                ENDIF
2297                IF ( check_existence( force%var_names, 'zw' ) )  THEN
2298                   ALLOCATE( force%zw_atmos(1:force%nzw) )
2299                   CALL get_variable( id_dynamic, 'zw', force%zw_atmos )
2300                ENDIF
2301
2302!
2303!--             Read surface pressure
2304                IF ( check_existence( force%var_names,                         &
2305                                  'surface_forcing_surface_pressure' ) )  THEN
2306                   ALLOCATE( force%surface_pressure(0:force%nt-1) )
2307                   CALL get_variable( id_dynamic,                              &
2308                                      'surface_forcing_surface_pressure',      &
2309                                      force%surface_pressure )
2310                ENDIF
2311!
2312!--             Set control flag to indicate that initialization is already done
2313                force%init = .TRUE.
2314
2315             ENDIF
2316
2317!
2318!--          Obtain time index for current input starting at 0.
2319!--          @todo: At the moment time, in INIFOR and simulated time correspond
2320!--                 to each other. If required, adjust to daytime.
2321             force%tind = MINLOC( ABS( force%time - simulated_time ), DIM = 1 )&
2322                          - 1
2323             force%tind_p = force%tind + 1 
2324!
2325!--          Read data at lateral and top boundaries. Please note, at left and
2326!--          right domain boundary, yz-layers are read for u, v, w, pt and q.
2327!--          For the v-component, the data starts at nysv, while for the other
2328!--          quantities the data starts at nys. This is equivalent at the north
2329!--          and south domain boundary for the u-component.
2330!--          The function get_variable_bc assumes the start indices with respect
2331!--          to the netcdf file convention (data starts at index 1). For this
2332!--          reason, nys+1 / nxl+1 are passed instead of nys / nxl. For the
2333!--          the u- and v-component at the north/south, and left/right boundary,
2334!--          nxlu and nysv are passed, respectively, since these always starts
2335!--          at index 1 in case of forcing.
2336
2337             IF ( force_bound_l )  THEN
2338                DO  j = nys, nyn
2339                   DO  t = force%tind, force%tind_p
2340                      CALL get_variable_bc( id_dynamic, 'ls_forcing_left_u',   &
2341                                      t+1,                                     &
2342                                      nzb+1, nzt+1-(nzb+1)+1,                  &
2343                                      j+1, 1,                                  &
2344                                      force%u_left(t-force%tind,nzb+1:nzt+1,j) )
2345                   ENDDO
2346                ENDDO
2347
2348                DO  j = nysv, nyn
2349                   DO  t = force%tind, force%tind_p
2350                      CALL get_variable_bc( id_dynamic, 'ls_forcing_left_v',   &
2351                                      t+1,                                     &
2352                                      nzb+1, nzt+1-(nzb+1)+1,                  &
2353                                      j, 1,                                    &
2354                                      force%v_left(t-force%tind,nzb+1:nzt+1,j) )
2355                   ENDDO
2356                ENDDO
2357                DO  j = nys, nyn
2358                   DO  t = force%tind, force%tind_p
2359                      CALL get_variable_bc( id_dynamic,                        &
2360                                      'ls_forcing_left_w',                     &
2361                                      t+1,                                     &
2362                                      nzb+1, nzt-(nzb+1) + 1,                  &
2363                                      j+1, 1,                                  &
2364                                      force%w_left(t-force%tind,nzb+1:nzt,j) )
2365                   ENDDO
2366                ENDDO
2367                IF ( .NOT. neutral )  THEN
2368                   DO  j = nys, nyn
2369                      DO  t = force%tind, force%tind_p
2370                         CALL get_variable_bc( id_dynamic,                     &
2371                                      'ls_forcing_left_pt',                    &
2372                                      t+1,                                     &
2373                                      nzb+1, nzt+1-(nzb+1)+1,                  &
2374                                      j+1, 1,                                  &
2375                                      force%pt_left(t-force%tind,nzb+1:nzt+1,j) )
2376                      ENDDO
2377                   ENDDO
2378                ENDIF
2379                IF ( humidity )  THEN
2380                   DO  j = nys, nyn
2381                      DO  t = force%tind, force%tind_p
2382                         CALL get_variable_bc( id_dynamic,                     &
2383                                      'ls_forcing_left_qv',                    &
2384                                      t+1,                                     &
2385                                      nzb+1, nzt+1-(nzb+1)+1,                  &
2386                                      j+1, 1,                                  &
2387                                      force%q_left(t-force%tind,nzb+1:nzt+1,j) )
2388                      ENDDO
2389                   ENDDO
2390                ENDIF
2391             ENDIF
2392
2393             IF ( force_bound_r )  THEN
2394                DO  j = nys, nyn
2395                   DO  t = force%tind, force%tind_p
2396                      CALL get_variable_bc( id_dynamic, 'ls_forcing_right_u',  &
2397                                      t+1,                                     &
2398                                      nzb+1, nzt+1-(nzb+1)+1,                  &
2399                                      j+1, 1,                                  &
2400                                      force%u_right(t-force%tind,nzb+1:nzt+1,j) )
2401                   ENDDO
2402                ENDDO
2403                DO  j = nysv, nyn
2404                   DO  t = force%tind, force%tind_p
2405                      CALL get_variable_bc( id_dynamic, 'ls_forcing_right_v',  &
2406                                      t+1,                                     &
2407                                      nzb+1, nzt+1-(nzb+1)+1,                  &
2408                                      j, 1,                                    &
2409                                      force%v_right(t-force%tind,nzb+1:nzt+1,j) )
2410                   ENDDO
2411                ENDDO
2412                DO  j = nys, nyn
2413                   DO  t = force%tind, force%tind_p
2414                      CALL get_variable_bc( id_dynamic, 'ls_forcing_right_w',  &
2415                                      t+1,                                     &
2416                                      nzb+1, nzt-(nzb+1)+1,                    &
2417                                      j+1, 1,                                  &
2418                                      force%w_right(t-force%tind,nzb+1:nzt,j) )
2419                   ENDDO
2420                ENDDO
2421                IF ( .NOT. neutral )  THEN
2422                   DO  j = nys, nyn
2423                      DO  t = force%tind, force%tind_p
2424                         CALL get_variable_bc( id_dynamic,                     &
2425                                      'ls_forcing_right_pt',                   &
2426                                      t+1,                                     &
2427                                      nzb+1, nzt+1-(nzb+1)+1,                  &
2428                                      j+1, 1,                                  &
2429                                      force%pt_right(t-force%tind,nzb+1:nzt+1,j) )
2430                      ENDDO
2431                   ENDDO
2432                ENDIF
2433                IF ( humidity )  THEN
2434                   DO  j = nys, nyn
2435                      DO  t = force%tind, force%tind_p
2436                         CALL get_variable_bc( id_dynamic,                     &
2437                                      'ls_forcing_right_qv',                   &
2438                                      t+1,                                     &
2439                                      nzb+1, nzt+1-(nzb+1)+1,                  &
2440                                      j+1, 1,                                  &
2441                                      force%q_right(t-force%tind,nzb+1:nzt+1,j) )
2442                      ENDDO
2443                   ENDDO
2444                ENDIF
2445             ENDIF
2446
2447             IF ( force_bound_n )  THEN
2448                DO  i = nxlu, nxr
2449                   DO  t = force%tind, force%tind_p
2450                      CALL get_variable_bc( id_dynamic, 'ls_forcing_north_u',  &
2451                                      t+1,                                     &
2452                                      nzb+1, nzt+1-(nzb+1)+1,                  &
2453                                      i, 1,                                    &
2454                                      force%u_north(t-force%tind,nzb+1:nzt+1,i) )
2455                   ENDDO
2456                ENDDO
2457                DO  i = nxl, nxr
2458                   DO  t = force%tind, force%tind_p
2459                      CALL get_variable_bc( id_dynamic, 'ls_forcing_north_v',  &
2460                                      t+1,                                     &
2461                                      nzb+1, nzt+1-(nzb+1)+1,                  &
2462                                      i+1, 1,                                  &
2463                                      force%v_north(t-force%tind,nzb+1:nzt+1,i) )
2464                   ENDDO
2465                ENDDO
2466                DO  i = nxl, nxr
2467                   DO  t = force%tind, force%tind_p
2468                      CALL get_variable_bc( id_dynamic, 'ls_forcing_north_w',  &
2469                                      t+1,                                     &
2470                                      nzb+1, nzt-(nzb+1)+1,                    &
2471                                      i+1, 1,                                  &
2472                                      force%w_north(t-force%tind,nzb+1:nzt,i) )
2473                   ENDDO
2474                ENDDO
2475                IF ( .NOT. neutral )  THEN
2476                   DO  i = nxl, nxr
2477                      DO  t = force%tind, force%tind_p
2478                         CALL get_variable_bc( id_dynamic,                     &
2479                                      'ls_forcing_north_pt',                   &
2480                                      t+1,                                     &
2481                                      nzb+1, nzt+1-(nzb+1)+1,                  &
2482                                      i+1, 1,                                  &
2483                                      force%pt_north(t-force%tind,nzb+1:nzt+1,i) )
2484                      ENDDO
2485                   ENDDO
2486                ENDIF
2487                IF ( humidity )  THEN
2488                   DO  i = nxl, nxr
2489                      DO  t = force%tind, force%tind_p
2490                         CALL get_variable_bc( id_dynamic,                     &
2491                                      'ls_forcing_north_qv',                   &
2492                                      t+1,                                     &
2493                                      nzb+1, nzt+1-(nzb+1)+1,                  &
2494                                      i+1, 1,                                  &
2495                                      force%q_north(t-force%tind,nzb+1:nzt+1,i) )
2496                      ENDDO
2497                   ENDDO
2498                ENDIF
2499             ENDIF
2500
2501             IF ( force_bound_s )  THEN
2502                DO  i = nxlu, nxr
2503                   DO  t = force%tind, force%tind_p
2504                      CALL get_variable_bc( id_dynamic, 'ls_forcing_south_u',  &
2505                                      t+1,                                     &
2506                                      nzb+1, nzt+1-(nzb+1)+1,                  &
2507                                      i, 1,                                    &
2508                                      force%u_south(t-force%tind,nzb+1:nzt+1,i) )
2509                   ENDDO
2510                ENDDO
2511                DO  i = nxl, nxr
2512                   DO  t = force%tind, force%tind_p
2513                      CALL get_variable_bc( id_dynamic, 'ls_forcing_south_v',  &
2514                                      t+1,                                     &
2515                                      nzb+1, nzt+1-(nzb+1)+1,                  &
2516                                      i+1, 1,                                  &
2517                                      force%v_south(t-force%tind,nzb+1:nzt+1,i) )
2518                   ENDDO
2519                ENDDO
2520                DO  i = nxl, nxr
2521                   DO  t = force%tind, force%tind_p
2522                      CALL get_variable_bc( id_dynamic, 'ls_forcing_south_w',  &
2523                                      t+1,                                     &
2524                                      nzb+1, nzt-(nzb+1)+1,                    &
2525                                      i+1, 1,                                  &
2526                                      force%w_south(t-force%tind,nzb+1:nzt,i) )
2527                   ENDDO
2528                ENDDO
2529                IF ( .NOT. neutral )  THEN
2530                   DO  i = nxl, nxr
2531                      DO  t = force%tind, force%tind_p
2532                         CALL get_variable_bc( id_dynamic,                     &
2533                                      'ls_forcing_south_pt',                   &
2534                                      t+1,                                     &
2535                                      nzb+1, nzt+1-(nzb+1)+1,                  &
2536                                      i+1, 1,                                  &
2537                                      force%pt_south(t-force%tind,nzb+1:nzt+1,i) )
2538                      ENDDO
2539                   ENDDO
2540                ENDIF
2541                IF ( humidity )  THEN
2542                   DO  i = nxl, nxr
2543                      DO  t = force%tind, force%tind_p
2544                         CALL get_variable_bc( id_dynamic,                     &
2545                                      'ls_forcing_south_qv',                   &
2546                                      t+1,                                     &
2547                                      nzb+1, nzt+1-(nzb+1)+1,                  &
2548                                      i+1, 1,                                  &
2549                                      force%q_south(t-force%tind,nzb+1:nzt+1,i) )
2550                      ENDDO
2551                   ENDDO
2552                ENDIF
2553             ENDIF
2554!
2555!--          Top boundary
2556             DO  i = nxlu, nxr
2557                DO  t = force%tind, force%tind_p
2558                   CALL get_variable_bc( id_dynamic, 'ls_forcing_top_u',       &
2559                                   t+1,                                        &
2560                                   nys+1, nyn-nys+1,                           &
2561                                   i, 1,                                       &
2562                                   force%u_top(t-force%tind,nys:nyn,i) )
2563                ENDDO
2564             ENDDO
2565             DO  i = nxl, nxr
2566                DO  t = force%tind, force%tind_p
2567                   CALL get_variable_bc( id_dynamic, 'ls_forcing_top_v',       &
2568                                   t+1,                                        &
2569                                   nysv, nyn-nysv+1,                           &
2570                                   i+1, 1,                                     &
2571                                   force%v_top(t-force%tind,nysv:nyn,i) )
2572                ENDDO
2573             ENDDO
2574             DO  i = nxl, nxr
2575                DO  t = force%tind, force%tind_p
2576                   CALL get_variable_bc( id_dynamic, 'ls_forcing_top_w',       &
2577                                   t+1,                                        &
2578                                   nys+1, nyn-nys+1,                           &
2579                                   i+1, 1,                                     &
2580                                   force%w_top(t-force%tind,nys:nyn,i) )
2581                ENDDO
2582             ENDDO
2583             IF ( .NOT. neutral )  THEN
2584                DO  i = nxl, nxr
2585                   DO  t = force%tind, force%tind_p
2586                      CALL get_variable_bc( id_dynamic, 'ls_forcing_top_pt',   &
2587                                      t+1,                                     &
2588                                      nys+1, nyn-nys+1,                        &
2589                                      i+1, 1,                                  &
2590                                      force%pt_top(t-force%tind,nys:nyn,i) )
2591                   ENDDO
2592                ENDDO
2593             ENDIF
2594             IF ( humidity )  THEN
2595                DO  i = nxl, nxr
2596                   DO  t = force%tind, force%tind_p
2597                      CALL get_variable_bc( id_dynamic, 'ls_forcing_top_qv',   &
2598                                      t+1,                                     &
2599                                      nys+1, nyn-nys+1,                        &
2600                                      i+1, 1,                                  &
2601                                      force%q_top(t-force%tind,nys:nyn,i) )
2602                   ENDDO
2603                ENDDO
2604             ENDIF
2605
2606!
2607!--          Close input file
2608             CALL close_input_file( id_dynamic )
2609#endif
2610          ENDIF
2611#if defined( __parallel )
2612          CALL MPI_BARRIER( comm2d, ierr )
2613#endif
2614       ENDDO
2615
2616!
2617!--    Finally, after data input set control flag indicating that vertical
2618!--    inter- and/or extrapolation is required.
2619!--    Please note, inter/extrapolation of INIFOR data is only a workaroud,
2620!--    as long as INIFOR delivers vertically equidistant data.
2621       force%interpolated = .FALSE. 
2622
2623    END SUBROUTINE netcdf_data_input_lsf
2624
2625
2626!------------------------------------------------------------------------------!
2627! Description:
2628! ------------
2629!> Checks input file for consistency and minimum requirements.
2630!------------------------------------------------------------------------------!
2631    SUBROUTINE netcdf_data_input_check_dynamic
2632
2633       USE control_parameters,                                                 &
2634           ONLY:  initializing_actions, forcing, message_string
2635
2636       USE pmc_interface,                                                      &
2637           ONLY:  nested_run
2638
2639       IMPLICIT NONE
2640
2641       LOGICAL      ::  check_nest !< flag indicating if a check passed
2642
2643!
2644!--    In case of forcing, check whether dynamic input file is present
2645       IF ( .NOT. input_pids_dynamic  .AND.  forcing )  THEN
2646          message_string = 'forcing = .TRUE. requires dynamic input file ' //  &
2647                            TRIM( input_file_dynamic ) // TRIM( coupling_char )
2648          CALL message( 'netcdf_data_input_mod', 'PA0430', 1, 2, 0, 6, 0 )
2649       ENDIF
2650!
2651!--    Dynamic input file must also be present if initialization via inifor is
2652!--    prescribed.
2653       IF ( .NOT. input_pids_dynamic  .AND.                                    &
2654            TRIM( initializing_actions ) == 'inifor' )  THEN
2655          message_string = 'initializing_actions = inifor requires dynamic ' //&
2656                           'input file ' // TRIM( input_file_dynamic ) //      &
2657                           TRIM( coupling_char )
2658          CALL message( 'netcdf_data_input_mod', 'PA0430', 1, 2, 0, 6, 0 )
2659       ENDIF
2660!
2661!--    In case of nested run assure that all domains are initialized the same
2662!--    way, i.e. if at least at one domain is initialized with soil and
2663!--    atmospheric data provided by COSMO, all domains must be initialized the
2664!--    same way, to assure that soil and atmospheric quantities are
2665!--    consistent.
2666       IF ( nested_run )  THEN
2667          check_nest = .TRUE.
2668#if defined( __parallel )
2669          CALL MPI_ALLREDUCE( TRIM( initializing_actions ) == 'inifor',        &
2670                              check_nest, 1, MPI_LOGICAL,                      &
2671                              MPI_LAND, MPI_COMM_WORLD, ierr )
2672
2673          IF ( TRIM( initializing_actions ) == 'inifor'  .AND.                 &
2674               .NOT.  check_nest )  THEN
2675             message_string = 'In case of nesting, if at least in one ' //     &
2676                              'domain initializing_actions = inifor, '  //     &
2677                              'all domains need to be initialized that way.'
2678             CALL message( 'netcdf_data_input_mod', 'PA0430', 3, 2, 0, 6, 0 )
2679          ENDIF
2680#endif
2681       ENDIF
2682
2683    END SUBROUTINE netcdf_data_input_check_dynamic
2684
2685!------------------------------------------------------------------------------!
2686! Description:
2687! ------------
2688!> Checks input file for consistency and minimum requirements.
2689!------------------------------------------------------------------------------!
2690    SUBROUTINE netcdf_data_input_check_static
2691
2692       USE control_parameters,                                                 &
2693           ONLY:  land_surface, message_string, urban_surface
2694
2695       USE indices,                                                            &
2696           ONLY:  nxl, nxr, nyn, nys
2697
2698       IMPLICIT NONE
2699
2700       INTEGER(iwp) ::  i      !< loop index along x-direction
2701       INTEGER(iwp) ::  j      !< loop index along y-direction
2702       INTEGER(iwp) ::  n_surf !< number of different surface types at given location
2703
2704       LOGICAL      ::  check_passed !< flag indicating if a check passed
2705
2706!
2707!--    Return if no static input file is available
2708       IF ( .NOT. input_pids_static )  RETURN 
2709!
2710!--    Check orography for fill-values. For the moment, give an error message.
2711!--    More advanced methods, e.g. a nearest neighbor algorithm as used in GIS
2712!--    systems might be implemented later.
2713       IF ( ANY( terrain_height_f%var == terrain_height_f%fill ) )  THEN
2714          message_string = 'NetCDF variable orography_2D is not ' //           &
2715                           'allowed to have missing data'
2716          CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )
2717       ENDIF
2718!
2719!--    Skip further checks concerning buildings and natural surface properties
2720!--    if no urban surface and land surface model are applied.
2721       IF (  .NOT. land_surface  .OR.  .NOT. urban_surface )  RETURN 
2722!
2723!--    Check for minimum requirement of surface-classification data in case
2724!--    static input file is used.
2725       IF ( .NOT. vegetation_type_f%from_file  .OR.                            &
2726            .NOT. pavement_type_f%from_file    .OR.                            &
2727            .NOT. building_type_f%from_file    .OR.                            &
2728            .NOT. water_type_f%from_file       .OR.                            &
2729            .NOT. soil_type_f%from_file             )  THEN
2730          message_string = 'Minimum requirement for surface classification ' //&
2731                           'is not fulfilled. At least ' //                    &
2732                           'vegetation_type, pavement_type, ' //               &
2733                           'building_type, soil_type and water_type are '//    &
2734                           'required.'
2735          CALL message( 'netcdf_data_input_mod', 'PA0999', 1, 2, 0, 6, 0 )
2736       ENDIF
2737!
2738!--    Check for general availability of input variables.
2739!--    If vegetation_type is 0 at any location, vegetation_pars as well as
2740!--    root_area_density_lsm are required.
2741       IF ( vegetation_type_f%from_file )  THEN
2742          IF ( ANY( vegetation_type_f%var == 0 ) )  THEN
2743             IF ( .NOT. vegetation_pars_f%from_file )  THEN
2744                message_string = 'If vegegation_type = 0 at any location, ' // &
2745                                 'vegetation_pars is required'
2746                CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )
2747             ENDIF
2748             IF ( .NOT. root_area_density_lsm_f%from_file )  THEN
2749                message_string = 'If vegegation_type = 0 at any location, ' // &
2750                                 'root_area_density_lsm is required'
2751                CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )
2752             ENDIF
2753          ENDIF
2754       ENDIF
2755!
2756!--    If soil_type is zero at any location, soil_pars is required.
2757       IF ( soil_type_f%from_file )  THEN
2758          check_passed = .TRUE. 
2759          IF ( ALLOCATED( soil_type_f%var_2d ) )  THEN
2760             IF ( ANY( soil_type_f%var_2d == 0 ) )  THEN
2761                IF ( .NOT. soil_pars_f%from_file )  check_passed = .FALSE.
2762             ENDIF
2763          ELSE
2764             IF ( ANY( soil_type_f%var_3d == 0 ) )  THEN
2765                IF ( .NOT. soil_pars_f%from_file )  check_passed = .FALSE.
2766             ENDIF
2767          ENDIF
2768          IF ( .NOT. check_passed )  THEN
2769             message_string = 'If soil_type = 0 at any location, ' //          &
2770                              'soil_pars is required'
2771             CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )         
2772          ENDIF
2773       ENDIF
2774!
2775!--    If building_type is zero at any location, building_pars is required.
2776       IF ( building_type_f%from_file )  THEN
2777          IF ( ANY( building_type_f%var == 0 ) )  THEN
2778             IF ( .NOT. building_pars_f%from_file )  THEN
2779                message_string = 'If building_type = 0 at any location, ' //   &
2780                                 'building_pars is required'
2781                CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )         
2782             ENDIF
2783          ENDIF
2784       ENDIF
2785!
2786!--    If albedo_type is zero at any location, albedo_pars is required.
2787       IF ( albedo_type_f%from_file )  THEN
2788          IF ( ANY( albedo_type_f%var == 0 ) )  THEN
2789             IF ( .NOT. albedo_pars_f%from_file )  THEN
2790                message_string = 'If albedo_type = 0 at any location, ' //     &
2791                                 'albedo_pars is required'
2792                CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )     
2793             ENDIF     
2794          ENDIF
2795       ENDIF
2796!
2797!--    If pavement_type is zero at any location, pavement_pars is required.
2798       IF ( pavement_type_f%from_file )  THEN
2799          IF ( ANY( pavement_type_f%var == 0 ) )  THEN
2800             IF ( .NOT. pavement_pars_f%from_file )  THEN
2801                message_string = 'If pavement_type = 0 at any location, ' //   &
2802                                 'pavement_pars is required'
2803                CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )     
2804             ENDIF     
2805          ENDIF
2806       ENDIF
2807!
2808!--    If pavement_type is zero at any location, also pavement_subsurface_pars
2809!--    is required.
2810       IF ( pavement_type_f%from_file )  THEN
2811          IF ( ANY( pavement_type_f%var == 0 ) )  THEN
2812             IF ( .NOT. pavement_subsurface_pars_f%from_file )  THEN
2813                message_string = 'If pavement_type = 0 at any location, ' //   &
2814                                 'pavement_subsurface_pars is required'
2815                CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )     
2816             ENDIF     
2817          ENDIF
2818       ENDIF
2819!
2820!--    If water_type is zero at any location, water_pars is required.
2821       IF ( water_type_f%from_file )  THEN
2822          IF ( ANY( water_type_f%var == 0 ) )  THEN
2823             IF ( .NOT. water_pars_f%from_file )  THEN
2824                message_string = 'If water_type = 0 at any location, ' //      &
2825                                 'water_pars is required'
2826                CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )     
2827             ENDIF     
2828          ENDIF
2829       ENDIF
2830!
2831!--    Check for local consistency of the input data.
2832       DO  i = nxl, nxr
2833          DO  j = nys, nyn
2834!
2835!--          For each (y,x)-location at least one of the parameters
2836!--          vegetation_type, pavement_type, building_type, or water_type
2837!--          must be set to a non­missing value.
2838             IF ( vegetation_type_f%var(j,i) == vegetation_type_f%fill  .AND.  &
2839                  pavement_type_f%var(j,i)   == pavement_type_f%fill    .AND.  &
2840                  building_type_f%var(j,i)   == building_type_f%fill    .AND.  &
2841                  water_type_f%var(j,i)      == water_type_f%fill )  THEN
2842                message_string = 'At least one of the paramters '       //     &
2843                                 'vegetation_type, pavement_type, '     //     &
2844                                 'building_type, or water_type must be set '// &
2845                                 'to a non-missing value'
2846                CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )
2847             ENDIF
2848!
2849!--          Note that a soil_type is required for each location (y,x) where
2850!--          either vegetation_type or pavement_type is a non­missing value.
2851             IF ( ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill  .OR. &
2852                    pavement_type_f%var(j,i)   /= pavement_type_f%fill ) )  THEN
2853                check_passed = .TRUE.
2854                IF ( ALLOCATED( soil_type_f%var_2d ) )  THEN
2855                   IF ( soil_type_f%var_2d(j,i) == soil_type_f%fill )          &
2856                      check_passed = .FALSE.
2857                ELSE
2858                   IF ( ANY( soil_type_f%var_3d(:,j,i) == soil_type_f%fill) )  &
2859                      check_passed = .FALSE.
2860                ENDIF
2861
2862                IF ( .NOT. check_passed )  THEN
2863                   message_string = 'soil_type is required for each '//        &
2864                                 'location (y,x) where vegetation_type or ' // &
2865                                 'pavement_type is a non-missing value.'
2866                   CALL message( 'netcdf_data_input_mod', 'PA0999',            &
2867                                  2, 2, 0, 6, 0 )
2868                ENDIF
2869             ENDIF
2870!
2871!--          Check for consistency of surface fraction. If more than one type
2872!--          is set, surface fraction need to be given and the sum must not
2873!--          be larger than 1.
2874             n_surf = 0
2875             IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill )       &
2876                n_surf = n_surf + 1
2877             IF ( water_type_f%var(j,i)      /= water_type_f%fill )            &
2878                n_surf = n_surf + 1
2879             IF ( pavement_type_f%var(j,i)   /= pavement_type_f%fill )         &
2880                n_surf = n_surf + 1
2881             
2882             IF ( n_surf > 1 )  THEN
2883                IF ( ANY ( surface_fraction_f%frac(:,j,i) ==                   &
2884                     surface_fraction_f%fill ) )  THEN
2885                   message_string = 'If more than one surface type is ' //     &
2886                                 'given at a location, surface_fraction ' //   &
2887                                 'must be provided.'
2888                   CALL message( 'netcdf_data_input_mod', 'PA0999',            &
2889                                  2, 2, 0, 6, 0 )
2890                ENDIF
2891                IF ( SUM ( surface_fraction_f%frac(:,j,i) ) > 1.0_wp )  THEN
2892                   message_string = 'surface_fraction must not exceed 1'
2893                   CALL message( 'netcdf_data_input_mod', 'PA0999',            &
2894                                  2, 2, 0, 6, 0 )
2895                ENDIF
2896             ENDIF
2897!
2898!--          Check vegetation_pars. If vegetation_type is 0, all parameters
2899!--          need to be set, otherwise, single parameters set by
2900!--          vegetation_type can be overwritten.
2901             IF ( vegetation_type_f%from_file )  THEN
2902                IF ( vegetation_type_f%var(j,i) == 0 )  THEN
2903                   IF ( ANY( vegetation_pars_f%pars_xy(:,j,i) ==               &
2904                             vegetation_pars_f%fill ) )  THEN
2905                      message_string = 'If vegetation_type(y,x) = 0, all '  // &
2906                                       'parameters of vegetation_pars at '//   & 
2907                                       'this location must be set.' 
2908                      CALL message( 'netcdf_data_input_mod', 'PA0999',         &
2909                                     2, 2, 0, 6, 0 )
2910                   ENDIF
2911                ENDIF
2912             ENDIF
2913!
2914!--          Check root distribution. If vegetation_type is 0, all levels must
2915!--          be set.
2916             IF ( vegetation_type_f%from_file )  THEN
2917                IF ( vegetation_type_f%var(j,i) == 0 )  THEN
2918                   IF ( ANY( root_area_density_lsm_f%var(:,j,i) ==             &
2919                             root_area_density_lsm_f%fill ) )  THEN
2920                      message_string = 'If vegetation_type(y,x) = 0, all ' //  &
2921                                       'levels of root_area_density_lsm ' //   &
2922                                       'must be set at this location.' 
2923                      CALL message( 'netcdf_data_input_mod', 'PA0999',         &
2924                                     2, 2, 0, 6, 0 )
2925                   ENDIF
2926                ENDIF
2927             ENDIF
2928!
2929!--          Check soil parameters. If soil_type is 0, all parameters 
2930!--          must be set.
2931             IF ( soil_type_f%from_file )  THEN
2932                check_passed = .TRUE.
2933                IF ( ALLOCATED( soil_type_f%var_2d ) )  THEN
2934                   IF ( soil_type_f%var_2d(j,i) == 0 )  THEN
2935                      IF ( ANY( soil_pars_f%pars_xy(:,j,i) ==                  &
2936                                soil_pars_f%fill ) )  check_passed = .FALSE.
2937                   ENDIF
2938                ELSE
2939                   IF ( ANY( soil_type_f%var_3d(:,j,i) == 0 ) )  THEN
2940                      IF ( ANY( soil_pars_f%pars_xy(:,j,i) ==                  &
2941                                soil_pars_f%fill ) )  check_passed = .FALSE.
2942                   ENDIF
2943                ENDIF
2944                IF ( .NOT. check_passed )  THEN
2945                   message_string = 'If soil_type(y,x) = 0, all levels of '  //& 
2946                                    'soil_pars at this location must be set.' 
2947                   CALL message( 'netcdf_data_input_mod', 'PA0999',            &
2948                                  2, 2, 0, 6, 0 )
2949                ENDIF
2950             ENDIF
2951
2952!
2953!--          Check building parameters. If building_type is 0, all parameters 
2954!--          must be set.
2955             IF ( building_type_f%from_file )  THEN
2956                IF ( building_type_f%var(j,i) == 0 )  THEN
2957                   IF ( ANY( building_pars_f%pars_xy(:,j,i) ==                 &
2958                             building_pars_f%fill ) )  THEN
2959                      message_string = 'If building_type(y,x) = 0, all ' //    &
2960                                       'parameters of building_pars at this '//&
2961                                       'location must be set.' 
2962                      CALL message( 'netcdf_data_input_mod', 'PA0999',         &
2963                                     2, 2, 0, 6, 0 )
2964                   ENDIF
2965                ENDIF
2966             ENDIF
2967!
2968!--          Check if building_type is set at each building
2969!              IF ( building_type_f%from_file  .AND.  buildings_f%from_file )  THEN
2970!                 IF ( buildings_f%var_2d(j,i) /= buildings_f%fill1  .AND.       &
2971!                      building_type_f%var(j,i) == building_type_f%fill )  THEN
2972!                       WRITE( message_string, * ) 'Each building requires ' //  &
2973!                                        ' a type. i, j = ', i, j
2974!                       CALL message( 'netcdf_data_input_mod', 'PA0999',         &
2975!                                      2, 2, 0, 6, 0 )
2976!                 ENDIF
2977!              ENDIF
2978!
2979!--          Check albedo parameters. If albedo_type is 0, all parameters 
2980!--          must be set.
2981             IF ( albedo_type_f%from_file )  THEN
2982                IF ( albedo_type_f%var(j,i) == 0 )  THEN
2983                   IF ( ANY( albedo_pars_f%pars_xy(:,j,i) ==                   &
2984                             albedo_pars_f%fill ) )  THEN
2985                      message_string = 'If albedo_type(y,x) = 0, all ' //      &
2986                                       'parameters of albedo_pars at this ' // &
2987                                       'location must be set.' 
2988                      CALL message( 'netcdf_data_input_mod', 'PA0999',         &
2989                                     2, 2, 0, 6, 0 )
2990                   ENDIF
2991                ENDIF
2992             ENDIF
2993
2994!
2995!--          Check pavement parameters. If pavement_type is 0, all parameters 
2996!--          of pavement_pars must be set at this location.
2997             IF ( pavement_type_f%from_file )  THEN
2998                IF ( pavement_type_f%var(j,i) == 0 )  THEN
2999                   IF ( ANY( pavement_pars_f%pars_xy(:,j,i) ==                 &
3000                             pavement_pars_f%fill ) )  THEN
3001                      message_string = 'If pavement_type(y,x) = 0, all ' //    &
3002                                       'parameters of pavement_pars at this '//&
3003                                       'location must be set.' 
3004                      CALL message( 'netcdf_data_input_mod', 'PA0999',         &
3005                                     2, 2, 0, 6, 0 )
3006                   ENDIF
3007                ENDIF
3008             ENDIF
3009!
3010!--          Check pavement-subsurface parameters. If pavement_type is 0,
3011!--          all parameters of pavement_subsurface_pars must be set  at this
3012!--          location.
3013             IF ( pavement_type_f%from_file )  THEN
3014                IF ( pavement_type_f%var(j,i) == 0 )  THEN
3015                   IF ( ANY( pavement_subsurface_pars_f%pars_xyz(:,:,j,i) ==   &
3016                             pavement_subsurface_pars_f%fill ) )  THEN
3017                      message_string = 'If pavement_type(y,x) = 0, all ' //    &
3018                                       'parameters of '                  //    &
3019                                       'pavement_subsurface_pars at this '//   &
3020                                       'location must be set.' 
3021                      CALL message( 'netcdf_data_input_mod', 'PA0999',         &
3022                                     2, 2, 0, 6, 0 )
3023                   ENDIF
3024                ENDIF
3025             ENDIF
3026
3027!
3028!--          Check water parameters. If water_type is 0, all parameters 
3029!--          must be set  at this location.
3030             IF ( water_type_f%from_file )  THEN
3031                IF ( water_type_f%var(j,i) == 0 )  THEN
3032                   IF ( ANY( water_pars_f%pars_xy(:,j,i) ==                    &
3033                             water_pars_f%fill ) )  THEN
3034                      message_string = 'If water_type(y,x) = 0, all ' //       &
3035                                       'parameters of water_pars at this ' //  &
3036                                       'location must be set.' 
3037                      CALL message( 'netcdf_data_input_mod', 'PA0999',         &
3038                                     2, 2, 0, 6, 0 )
3039                   ENDIF
3040                ENDIF
3041             ENDIF
3042
3043          ENDDO
3044       ENDDO
3045
3046    END SUBROUTINE netcdf_data_input_check_static
3047
3048!------------------------------------------------------------------------------!
3049! Description:
3050! ------------
3051!> Vertical interpolation and extrapolation of 1D variables.
3052!------------------------------------------------------------------------------!
3053    SUBROUTINE netcdf_data_input_interpolate_1d( var, z_grid, z_file)
3054
3055       IMPLICIT NONE
3056
3057       LOGICAL      ::  top     !< flag indicating extrapolation at model top
3058
3059       INTEGER(iwp) ::  k       !< running index z-direction file
3060       INTEGER(iwp) ::  kk      !< running index z-direction stretched model grid
3061       INTEGER(iwp) ::  kl      !< lower index bound along z-direction
3062       INTEGER(iwp) ::  ku      !< upper index bound along z-direction
3063       INTEGER(iwp) ::  nz_file !< number of vertical levels on file
3064
3065
3066       REAL(wp), DIMENSION(:) ::  z_grid                  !< grid levels on numeric grid
3067       REAL(wp), DIMENSION(:) ::  z_file                  !< grid levels on file grid
3068       REAL(wp), DIMENSION(:), INTENT(INOUT) ::  var      !< treated variable
3069       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  var_tmp  !< temporary variable
3070
3071
3072       kl = LBOUND(var,1)
3073       ku = UBOUND(var,1)
3074       ALLOCATE( var_tmp(kl:ku) )
3075
3076       DO  k = kl, ku
3077
3078          kk = MINLOC( ABS( z_file - z_grid(k) ), DIM = 1 )
3079
3080          IF ( kk < ku )  THEN
3081             IF ( z_file(kk) - z_grid(k) <= 0.0_wp )  THEN
3082                var_tmp(k) = var(kk) +                                         &
3083                                       ( var(kk+1)        - var(kk)    ) /     &
3084                                       ( z_file(kk+1)     - z_file(kk) ) *     &
3085                                       ( z_grid(k)        - z_file(kk) ) 
3086
3087             ELSEIF ( z_file(kk) - z_grid(k) > 0.0_wp )  THEN
3088                var_tmp(k) = var(kk-1) +                                       &
3089                                         ( var(kk)     - var(kk-1)    ) /      &
3090                                         ( z_file(kk)  - z_file(kk-1) ) *      &
3091                                         ( z_grid(k)   - z_file(kk-1) ) 
3092             ENDIF
3093!
3094!--       Extrapolate
3095          ELSE
3096     
3097             var_tmp(k) = var(ku) +   ( var(ku)    - var(ku-1)      ) /        &
3098                                      ( z_file(ku) - z_file(ku-1)   ) *        &
3099                                      ( z_grid(k)  - z_file(ku)     ) 
3100   
3101          ENDIF
3102
3103       ENDDO
3104       var(:) = var_tmp(:)
3105
3106       DEALLOCATE( var_tmp )
3107
3108
3109    END SUBROUTINE netcdf_data_input_interpolate_1d
3110
3111
3112!------------------------------------------------------------------------------!
3113! Description:
3114! ------------
3115!> Vertical interpolation and extrapolation of 1D variables from Inifor grid
3116!> onto Palm grid, where both have same dimension. Please note, the passed
3117!> paramter list in 1D version is different compared to 2D version.
3118!------------------------------------------------------------------------------!
3119    SUBROUTINE netcdf_data_input_interpolate_1d_soil( var, var_file,           &
3120                                                      z_grid, z_file,          &
3121                                                      nzb_var, nzt_var,        & 
3122                                                      nzb_file, nzt_file )
3123
3124       IMPLICIT NONE
3125
3126       INTEGER(iwp) ::  i        !< running index x-direction
3127       INTEGER(iwp) ::  j        !< running index y-direction
3128       INTEGER(iwp) ::  k        !< running index z-direction file
3129       INTEGER(iwp) ::  kk       !< running index z-direction stretched model grid
3130       INTEGER(iwp) ::  ku       !< upper index bound along z-direction for varialbe from file
3131       INTEGER(iwp) ::  nzb_var  !< lower bound of final array
3132       INTEGER(iwp) ::  nzt_var  !< upper bound of final array
3133       INTEGER(iwp) ::  nzb_file !< lower bound of file array
3134       INTEGER(iwp) ::  nzt_file !< upper bound of file array
3135
3136!        LOGICAL, OPTIONAL ::  depth !< flag indicating reverse z-axis, i.e. depth instead of height, e.g. in case of ocean or soil
3137
3138       REAL(wp), DIMENSION(nzb_var:nzt_var)   ::  z_grid   !< grid levels on numeric grid
3139       REAL(wp), DIMENSION(nzb_file:nzt_file) ::  z_file   !< grid levels on file grid
3140       REAL(wp), DIMENSION(nzb_var:nzt_var)   ::  var      !< treated variable
3141       REAL(wp), DIMENSION(nzb_file:nzt_file) ::  var_file !< temporary variable
3142
3143       ku = nzt_file
3144
3145       DO  k = nzb_var, nzt_var
3146!
3147!--       Determine index on Inifor grid which is closest to the actual height
3148          kk = MINLOC( ABS( z_file - z_grid(k) ), DIM = 1 )
3149!
3150!--       If closest index on Inifor grid is smaller than top index,
3151!--       interpolate the data
3152          IF ( kk < nzt_file )  THEN
3153             IF ( z_file(kk) - z_grid(k) <= 0.0_wp )  THEN
3154                var(k) = var_file(kk) + ( var_file(kk+1) - var_file(kk) ) /    &
3155                                        ( z_file(kk+1)   - z_file(kk)   ) *    &
3156                                        ( z_grid(k)      - z_file(kk)   ) 
3157
3158             ELSEIF ( z_file(kk) - z_grid(k) > 0.0_wp )  THEN
3159                var(k) = var_file(kk-1) + ( var_file(kk) - var_file(kk-1) ) /  &
3160                                          ( z_file(kk)   - z_file(kk-1)   ) *  &
3161                                          ( z_grid(k)    - z_file(kk-1)   ) 
3162             ENDIF
3163!
3164!--       Extrapolate if actual height is above the highest Inifor level
3165          ELSE
3166             var(k) = var_file(ku) + ( var_file(ku) - var_file(ku-1) ) /       &
3167                                     ( z_file(ku)   - z_file(ku-1)   ) *       &
3168                                     ( z_grid(k)    - z_file(ku)     ) 
3169
3170          ENDIF
3171
3172       ENDDO
3173
3174    END SUBROUTINE netcdf_data_input_interpolate_1d_soil
3175
3176!------------------------------------------------------------------------------!
3177! Description:
3178! ------------
3179!> Vertical interpolation and extrapolation of 2D variables at lateral boundaries.
3180!------------------------------------------------------------------------------!
3181    SUBROUTINE netcdf_data_input_interpolate_2d( var, z_grid, z_file)
3182
3183       IMPLICIT NONE
3184
3185       LOGICAL      ::  top     !< flag indicating extrapolation at model top
3186
3187       INTEGER(iwp) ::  i       !< running index x- or y -direction
3188       INTEGER(iwp) ::  il      !< lower index bound along x- or y-direction
3189       INTEGER(iwp) ::  iu      !< upper index bound along x- or y-direction
3190       INTEGER(iwp) ::  k       !< running index z-direction file
3191       INTEGER(iwp) ::  kk      !< running index z-direction stretched model grid
3192       INTEGER(iwp) ::  kl      !< lower index bound along z-direction
3193       INTEGER(iwp) ::  ku      !< upper index bound along z-direction
3194       INTEGER(iwp) ::  nz_file !< number of vertical levels on file
3195
3196
3197       REAL(wp), DIMENSION(:) ::  z_grid                  !< grid levels on numeric grid
3198       REAL(wp), DIMENSION(:) ::  z_file                  !< grid levels on file grid
3199       REAL(wp), DIMENSION(:,:), INTENT(INOUT) ::  var    !< treated variable
3200       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  var_tmp  !< temporary variable
3201
3202
3203       il = LBOUND(var,2)
3204       iu = UBOUND(var,2)
3205       kl = LBOUND(var,1)
3206       ku = UBOUND(var,1)
3207       ALLOCATE( var_tmp(kl:ku) )
3208
3209       DO  i = il, iu
3210          DO  k = kl, ku
3211
3212             kk = MINLOC( ABS( z_file - z_grid(k) ), DIM = 1 )
3213
3214             IF ( kk < ku )  THEN
3215                IF ( z_file(kk) - z_grid(k) <= 0.0_wp )  THEN
3216                   var_tmp(k) = var(kk,i) +                                    &
3217                                          ( var(kk+1,i)      - var(kk,i)  ) /  &
3218                                          ( z_file(kk+1)     - z_file(kk) ) *  &
3219                                          ( z_grid(k)        - z_file(kk) ) 
3220
3221                ELSEIF ( z_file(kk) - z_grid(k) > 0.0_wp )  THEN
3222                   var_tmp(k) = var(kk-1,i) +                                  &
3223                                            ( var(kk,i)   - var(kk-1,i)  ) /   &
3224                                            ( z_file(kk)  - z_file(kk-1) ) *   &
3225                                            ( z_grid(k)   - z_file(kk-1) ) 
3226                ENDIF
3227!
3228!--          Extrapolate
3229             ELSE
3230     
3231                var_tmp(k) = var(ku,i) + ( var(ku,i)  - var(ku-1,i)    ) /     &
3232                                         ( z_file(ku) - z_file(ku-1)   ) *     &
3233                                         ( z_grid(k)  - z_file(ku)     ) 
3234   
3235             ENDIF
3236
3237          ENDDO
3238          var(:,i) = var_tmp(:)
3239
3240       ENDDO
3241
3242       DEALLOCATE( var_tmp )
3243
3244
3245    END SUBROUTINE netcdf_data_input_interpolate_2d
3246
3247!------------------------------------------------------------------------------!
3248! Description:
3249! ------------
3250!> Vertical interpolation and extrapolation of 3D variables.
3251!------------------------------------------------------------------------------!
3252    SUBROUTINE netcdf_data_input_interpolate_3d( var, z_grid, z_file )
3253
3254       IMPLICIT NONE
3255
3256       INTEGER(iwp) ::  i       !< running index x-direction
3257       INTEGER(iwp) ::  il      !< lower index bound along x-direction
3258       INTEGER(iwp) ::  iu      !< upper index bound along x-direction
3259       INTEGER(iwp) ::  j       !< running index y-direction
3260       INTEGER(iwp) ::  jl      !< lower index bound along x-direction
3261       INTEGER(iwp) ::  ju      !< upper index bound along x-direction
3262       INTEGER(iwp) ::  k       !< running index z-direction file
3263       INTEGER(iwp) ::  kk      !< running index z-direction stretched model grid
3264       INTEGER(iwp) ::  kl      !< lower index bound along z-direction
3265       INTEGER(iwp) ::  ku      !< upper index bound along z-direction
3266       INTEGER(iwp) ::  nz_file !< number of vertical levels on file
3267
3268       REAL(wp), DIMENSION(:) ::  z_grid                      !< grid levels on numeric grid
3269       REAL(wp), DIMENSION(:) ::  z_file                      !< grid levels on file grid
3270       REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) ::  var      !< treated variable
3271       REAL(wp), DIMENSION(:), ALLOCATABLE       ::  var_tmp  !< temporary variable
3272
3273       il = LBOUND(var,3)
3274       iu = UBOUND(var,3)
3275       jl = LBOUND(var,2)
3276       ju = UBOUND(var,2)
3277       kl = LBOUND(var,1)
3278       ku = UBOUND(var,1)
3279
3280       ALLOCATE( var_tmp(kl:ku) )
3281
3282       DO  i = il, iu
3283          DO  j = jl, ju
3284             DO  k = kl, ku
3285
3286                kk = MINLOC( ABS( z_file - z_grid(k) ), DIM = 1 ) 
3287
3288                IF ( kk < ku )  THEN
3289                   IF ( z_file(kk) - z_grid(k) <= 0.0_wp )  THEN
3290                      var_tmp(k) = var(kk,j,i) +                               &
3291                                             ( var(kk+1,j,i) - var(kk,j,i) ) / &
3292                                             ( z_file(kk+1)  - z_file(kk)  ) * &
3293                                             ( z_grid(k)     - z_file(kk)  ) 
3294
3295                   ELSEIF ( z_file(kk) - z_grid(k) > 0.0_wp )  THEN
3296                      var_tmp(k) = var(kk-1,j,i) +                             &
3297                                             ( var(kk,j,i) - var(kk-1,j,i) ) / &
3298                                             ( z_file(kk)  - z_file(kk-1)  ) * &
3299                                             ( z_grid(k)   - z_file(kk-1)  ) 
3300                   ENDIF
3301!
3302!--             Extrapolate
3303                ELSE
3304                   var_tmp(k) = var(ku,j,i) +                                  &
3305                                       ( var(ku,j,i)  - var(ku-1,j,i)   ) /    &
3306                                       ( z_file(ku)   - z_file(ku-1)    ) *    &
3307                                       ( z_grid(k)    - z_file(ku)      ) 
3308
3309                ENDIF
3310             ENDDO
3311             var(:,j,i) = var_tmp(:)
3312          ENDDO
3313       ENDDO
3314
3315       DEALLOCATE( var_tmp )
3316
3317
3318    END SUBROUTINE netcdf_data_input_interpolate_3d
3319
3320!------------------------------------------------------------------------------!
3321! Description:
3322! ------------
3323!> Checks if a given variables is on file
3324!------------------------------------------------------------------------------!
3325    FUNCTION check_existence( vars_in_file, var_name )
3326
3327       IMPLICIT NONE
3328
3329       CHARACTER(LEN=*) ::  var_name                   !< variable to be checked
3330       CHARACTER(LEN=*), DIMENSION(:) ::  vars_in_file !< list of variables in file
3331
3332       INTEGER(iwp) ::  i                              !< loop variable
3333
3334       LOGICAL ::  check_existence                     !< flag indicating whether a variable exist or not - actual return value
3335
3336       i = 1
3337       check_existence = .FALSE.
3338       DO  WHILE ( i <= SIZE( vars_in_file ) )
3339          check_existence = TRIM( vars_in_file(i) ) == TRIM( var_name )  .OR.  &
3340                            check_existence
3341          i = i + 1
3342       ENDDO
3343
3344       RETURN
3345
3346    END FUNCTION check_existence
3347
3348
3349!------------------------------------------------------------------------------!
3350! Description:
3351! ------------
3352!> Closes an existing netCDF file.
3353!------------------------------------------------------------------------------!
3354    SUBROUTINE close_input_file( id )
3355#if defined( __netcdf )
3356
3357       USE pegrid
3358
3359       IMPLICIT NONE
3360
3361       INTEGER(iwp), INTENT(INOUT)        ::  id        !< file id
3362
3363       nc_stat = NF90_CLOSE( id )
3364       CALL handle_error( 'close', 537 )
3365#endif
3366    END SUBROUTINE close_input_file
3367
3368!------------------------------------------------------------------------------!
3369! Description:
3370! ------------
3371!> Opens an existing netCDF file for reading only and returns its id.
3372!------------------------------------------------------------------------------!
3373    SUBROUTINE open_read_file( filename, id )
3374#if defined( __netcdf )
3375
3376       USE pegrid
3377
3378       IMPLICIT NONE
3379
3380       CHARACTER (LEN=*), INTENT(IN) ::  filename  !< filename
3381       INTEGER(iwp), INTENT(INOUT)   ::  id        !< file id
3382       LOGICAL                       ::  file_open = .FALSE.
3383
3384       nc_stat = NF90_OPEN( filename, NF90_NOWRITE, id )
3385
3386       CALL handle_error( 'open_read_file', 536 )
3387
3388#endif
3389    END SUBROUTINE open_read_file
3390
3391!------------------------------------------------------------------------------!
3392! Description:
3393! ------------
3394!> Reads global or variable-related attributes of type INTEGER (32-bit)
3395!------------------------------------------------------------------------------!
3396     SUBROUTINE get_attribute_int32( id, attribute_name, value, global,        &
3397                                     variable_name )
3398#if defined( __netcdf )
3399
3400       USE pegrid
3401
3402       IMPLICIT NONE
3403
3404       CHARACTER(LEN=*)            ::  attribute_name   !< attribute name
3405       CHARACTER(LEN=*), OPTIONAL  ::  variable_name    !< variable name
3406
3407       INTEGER(iwp), INTENT(IN)    ::  id               !< file id
3408       INTEGER(iwp)                ::  id_var           !< variable id
3409       INTEGER(iwp), INTENT(INOUT) ::  value            !< read value
3410
3411       LOGICAL, INTENT(IN) ::  global                   !< flag indicating global attribute
3412
3413!
3414!--    Read global attribute
3415       IF ( global )  THEN
3416          nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
3417          CALL handle_error( 'get_attribute_int32 global', 522 )
3418!
3419!--    Read attributes referring to a single variable. Therefore, first inquire
3420!--    variable id
3421       ELSE
3422          nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
3423          CALL handle_error( 'get_attribute_int32', 522 )
3424          nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
3425          CALL handle_error( 'get_attribute_int32', 522 )       
3426       ENDIF
3427#endif
3428    END SUBROUTINE get_attribute_int32
3429
3430!------------------------------------------------------------------------------!
3431! Description:
3432! ------------
3433!> Reads global or variable-related attributes of type INTEGER (8-bit)
3434!------------------------------------------------------------------------------!
3435     SUBROUTINE get_attribute_int8( id, attribute_name, value, global,         &
3436                                    variable_name )
3437#if defined( __netcdf )
3438
3439       USE pegrid
3440
3441       IMPLICIT NONE
3442
3443       CHARACTER(LEN=*)            ::  attribute_name   !< attribute name
3444       CHARACTER(LEN=*), OPTIONAL  ::  variable_name    !< variable name
3445
3446       INTEGER(iwp), INTENT(IN)    ::  id               !< file id
3447       INTEGER(iwp)                ::  id_var           !< variable id
3448       INTEGER(KIND=1), INTENT(INOUT) ::  value         !< read value
3449
3450       LOGICAL, INTENT(IN) ::  global                   !< flag indicating global attribute
3451
3452!
3453!--    Read global attribute
3454       IF ( global )  THEN
3455          nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
3456          CALL handle_error( 'get_attribute_int8 global', 523 )
3457!
3458!--    Read attributes referring to a single variable. Therefore, first inquire
3459!--    variable id
3460       ELSE
3461          nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
3462          CALL handle_error( 'get_attribute_int8', 523 )
3463          nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
3464          CALL handle_error( 'get_attribute_int8', 523 )       
3465       ENDIF
3466#endif
3467    END SUBROUTINE get_attribute_int8
3468
3469!------------------------------------------------------------------------------!
3470! Description:
3471! ------------
3472!> Reads global or variable-related attributes of type REAL
3473!------------------------------------------------------------------------------!
3474     SUBROUTINE get_attribute_real( id, attribute_name, value, global,         &
3475                                    variable_name )
3476#if defined( __netcdf )
3477
3478       USE pegrid
3479
3480       IMPLICIT NONE
3481
3482       CHARACTER(LEN=*)            ::  attribute_name   !< attribute name
3483       CHARACTER(LEN=*), OPTIONAL  ::  variable_name    !< variable name
3484
3485       INTEGER(iwp), INTENT(IN)    ::  id               !< file id
3486       INTEGER(iwp)                ::  id_var           !< variable id
3487
3488       LOGICAL, INTENT(IN) ::  global                   !< flag indicating global attribute
3489
3490       REAL(wp), INTENT(INOUT)     ::  value            !< read value
3491
3492
3493!
3494!-- Read global attribute
3495       IF ( global )  THEN
3496          nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
3497          CALL handle_error( 'get_attribute_real global', 524 )
3498!
3499!-- Read attributes referring to a single variable. Therefore, first inquire
3500!-- variable id
3501       ELSE
3502          nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
3503          CALL handle_error( 'get_attribute_real', 524 )
3504          nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
3505          CALL handle_error( 'get_attribute_real', 524 )       
3506       ENDIF
3507#endif
3508    END SUBROUTINE get_attribute_real
3509
3510!------------------------------------------------------------------------------!
3511! Description:
3512! ------------
3513!> Reads global or variable-related attributes of type CHARACTER
3514!> Remark: reading attributes of type NF_STRING return an error code 56 -
3515!> Attempt to convert between text & numbers.
3516!------------------------------------------------------------------------------!
3517     SUBROUTINE get_attribute_string( id, attribute_name, value, global,       &
3518                                      variable_name )
3519#if defined( __netcdf )
3520
3521       USE pegrid
3522
3523       IMPLICIT NONE
3524
3525       CHARACTER(LEN=*)                ::  attribute_name   !< attribute name
3526       CHARACTER(LEN=*), OPTIONAL      ::  variable_name    !< variable name
3527       CHARACTER(LEN=*), INTENT(INOUT) ::  value            !< read value
3528
3529       INTEGER(iwp), INTENT(IN)    ::  id               !< file id
3530       INTEGER(iwp)                ::  id_var           !< variable id
3531
3532       LOGICAL, INTENT(IN) ::  global                   !< flag indicating global attribute
3533
3534!
3535!--    Read global attribute
3536       IF ( global )  THEN
3537          nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
3538          CALL handle_error( 'get_attribute_string global', 525 )
3539!
3540!--    Read attributes referring to a single variable. Therefore, first inquire
3541!--    variable id
3542       ELSE
3543          nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
3544          CALL handle_error( 'get_attribute_string', 525 )
3545
3546          nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
3547          CALL handle_error( 'get_attribute_string',525 ) 
3548
3549       ENDIF
3550#endif
3551    END SUBROUTINE get_attribute_string
3552
3553
3554
3555!------------------------------------------------------------------------------!
3556! Description:
3557! ------------
3558!> Get dimension array for a given dimension
3559!------------------------------------------------------------------------------!
3560     SUBROUTINE get_dimension_length( id, dim_len, variable_name )
3561#if defined( __netcdf )
3562
3563       USE pegrid
3564
3565       IMPLICIT NONE
3566
3567       CHARACTER(LEN=*)            ::  variable_name    !< dimension name
3568       CHARACTER(LEN=100)          ::  dum              !< dummy variable to receive return character
3569
3570       INTEGER(iwp)                ::  dim_len          !< dimension size
3571       INTEGER(iwp), INTENT(IN)    ::  id               !< file id
3572       INTEGER(iwp)                ::  id_dim           !< dimension id
3573
3574!
3575!--    First, inquire dimension ID
3576       nc_stat = NF90_INQ_DIMID( id, TRIM( variable_name ), id_dim )
3577       CALL handle_error( 'get_dimension_length', 526 )
3578!
3579!--    Inquire dimension length
3580       nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim, dum, LEN = dim_len )
3581       CALL handle_error( 'get_dimension_length', 526 ) 
3582
3583#endif
3584    END SUBROUTINE get_dimension_length
3585
3586!------------------------------------------------------------------------------!
3587! Description:
3588! ------------
3589!> Reads a 1D integer variable from file.
3590!------------------------------------------------------------------------------!
3591     SUBROUTINE get_variable_1d_int( id, variable_name, var )
3592#if defined( __netcdf )
3593
3594       USE pegrid
3595
3596       IMPLICIT NONE
3597
3598       CHARACTER(LEN=*)            ::  variable_name    !< variable name
3599
3600       INTEGER(iwp), INTENT(IN)    ::  id               !< file id
3601       INTEGER(iwp)                ::  id_var           !< dimension id
3602
3603       INTEGER(iwp), DIMENSION(:), INTENT(INOUT) ::  var  !< variable to be read
3604
3605!
3606!--    First, inquire variable ID
3607       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
3608       CALL handle_error( 'get_variable_1d_int', 527 )
3609!
3610!--    Inquire dimension length
3611       nc_stat = NF90_GET_VAR( id, id_var, var )
3612       CALL handle_error( 'get_variable_1d_int', 527 ) 
3613
3614#endif
3615    END SUBROUTINE get_variable_1d_int
3616
3617!------------------------------------------------------------------------------!
3618! Description:
3619! ------------
3620!> Reads a 1D float variable from file.
3621!------------------------------------------------------------------------------!
3622     SUBROUTINE get_variable_1d_real( id, variable_name, var )
3623#if defined( __netcdf )
3624
3625       USE pegrid
3626
3627       IMPLICIT NONE
3628
3629       CHARACTER(LEN=*)            ::  variable_name    !< variable name
3630
3631       INTEGER(iwp), INTENT(IN)    ::  id               !< file id
3632       INTEGER(iwp)                ::  id_var           !< dimension id
3633
3634       REAL(wp), DIMENSION(:), INTENT(INOUT) ::  var  !< variable to be read
3635
3636!
3637!--    First, inquire variable ID
3638       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
3639       CALL handle_error( 'get_variable_1d_real', 527 )
3640!
3641!--    Inquire dimension length
3642       nc_stat = NF90_GET_VAR( id, id_var, var )
3643       CALL handle_error( 'get_variable_1d_real', 527 ) 
3644
3645#endif
3646    END SUBROUTINE get_variable_1d_real
3647
3648!------------------------------------------------------------------------------!
3649! Description:
3650! ------------
3651!> Reads a 2D REAL variable from a file. Reading is done processor-wise,
3652!> i.e. each core reads its own domain in slices along x.
3653!------------------------------------------------------------------------------!
3654    SUBROUTINE get_variable_2d_real( id, variable_name, i, var )
3655#if defined( __netcdf )
3656
3657       USE indices
3658       USE pegrid
3659
3660       IMPLICIT NONE
3661
3662       CHARACTER(LEN=*)              ::  variable_name   !< variable name
3663
3664       INTEGER(iwp), INTENT(IN)      ::  i               !< index along x direction
3665       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
3666       INTEGER(iwp)                  ::  id_var          !< variable id
3667
3668       REAL(wp), DIMENSION(nys:nyn), INTENT(INOUT) ::  var  !< variable to be read
3669!
3670!--    Inquire variable id
3671       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
3672!
3673!--    Get variable
3674       nc_stat = NF90_GET_VAR( id, id_var, var(nys:nyn),                       &
3675                               start = (/ i+1, nys+1 /),                       &
3676                               count = (/ 1, nyn - nys + 1 /) )
3677
3678       CALL handle_error( 'get_variable_2d_real', 528 )
3679#endif
3680    END SUBROUTINE get_variable_2d_real
3681
3682!------------------------------------------------------------------------------!
3683! Description:
3684! ------------
3685!> Reads a 2D 32-bit INTEGER variable from file. Reading is done processor-wise,
3686!> i.e. each core reads its own domain in slices along x.
3687!------------------------------------------------------------------------------!
3688    SUBROUTINE get_variable_2d_int32( id, variable_name, i, var )
3689#if defined( __netcdf )
3690
3691       USE indices
3692       USE pegrid
3693
3694       IMPLICIT NONE
3695
3696       CHARACTER(LEN=*)              ::  variable_name   !< variable name
3697
3698       INTEGER(iwp), INTENT(IN)      ::  i               !< index along x direction
3699       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
3700       INTEGER(iwp)                  ::  id_var          !< variable id
3701       INTEGER(iwp), DIMENSION(nys:nyn), INTENT(INOUT) ::  var  !< variable to be read
3702!
3703!--    Inquire variable id
3704       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
3705!
3706!--    Get variable
3707       nc_stat = NF90_GET_VAR( id, id_var, var(nys:nyn),                       &
3708                               start = (/ i+1, nys+1 /),                       &
3709                               count = (/ 1, nyn - nys + 1 /) )
3710
3711       CALL handle_error( 'get_variable_2d_int32', 529 )
3712#endif
3713    END SUBROUTINE get_variable_2d_int32
3714
3715!------------------------------------------------------------------------------!
3716! Description:
3717! ------------
3718!> Reads a 2D 8-bit INTEGER variable from file. Reading is done processor-wise,
3719!> i.e. each core reads its own domain in slices along x.
3720!------------------------------------------------------------------------------!
3721    SUBROUTINE get_variable_2d_int8( id, variable_name, i, var )
3722#if defined( __netcdf )
3723
3724       USE indices
3725       USE pegrid
3726
3727       IMPLICIT NONE
3728
3729       CHARACTER(LEN=*)              ::  variable_name   !< variable name
3730
3731       INTEGER(iwp), INTENT(IN)      ::  i               !< index along x direction
3732       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
3733       INTEGER(iwp)                  ::  id_var          !< variable id
3734       INTEGER(KIND=1), DIMENSION(nys:nyn), INTENT(INOUT) ::  var  !< variable to be read
3735!
3736!--    Inquire variable id
3737       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
3738!
3739!--    Get variable
3740       nc_stat = NF90_GET_VAR( id, id_var, var(nys:nyn),                       &
3741                               start = (/ i+1, nys+1 /),                       &
3742                               count = (/ 1, nyn - nys + 1 /) )
3743
3744       CALL handle_error( 'get_variable_2d_int8', 530 )
3745#endif
3746    END SUBROUTINE get_variable_2d_int8
3747
3748!------------------------------------------------------------------------------!
3749! Description:
3750! ------------
3751!> Reads a 3D 8-bit INTEGER variable from file.
3752!------------------------------------------------------------------------------!
3753    SUBROUTINE get_variable_3d_int8( id, variable_name, i, j, var )
3754#if defined( __netcdf )
3755
3756       USE indices
3757       USE pegrid
3758
3759       IMPLICIT NONE
3760
3761       CHARACTER(LEN=*)              ::  variable_name   !< variable name
3762
3763       INTEGER(iwp), INTENT(IN)      ::  i               !< index along x direction
3764       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
3765       INTEGER(iwp)                  ::  id_var          !< variable id
3766       INTEGER(iwp), INTENT(IN)      ::  j               !< index along y direction
3767       INTEGER(iwp)                  ::  n_file          !< number of data-points along 3rd dimension
3768
3769       INTEGER(iwp), DIMENSION(1:3)  ::  id_dim
3770
3771       INTEGER( KIND = 1 ), DIMENSION(nzb:nzt+1), INTENT(INOUT) ::  var  !< variable to be read
3772
3773!
3774!--    Inquire variable id
3775       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
3776!
3777!--    Get length of first dimension, required for the count parameter.
3778!--    Therefore, first inquired dimension ids
3779       nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, DIMIDS = id_dim )
3780       nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(3), LEN = n_file )
3781!
3782!--    Get variable
3783       nc_stat = NF90_GET_VAR( id, id_var, var,                  &
3784                               start = (/ i+1, j+1, 1 /),                      &
3785                               count = (/ 1, 1, n_file /) )
3786
3787       CALL handle_error( 'get_variable_3d_int8', 531 )
3788#endif
3789    END SUBROUTINE get_variable_3d_int8
3790
3791
3792!------------------------------------------------------------------------------!
3793! Description:
3794! ------------
3795!> Reads a 3D float variable from file. 
3796!------------------------------------------------------------------------------!
3797    SUBROUTINE get_variable_3d_real( id, variable_name, i, j, var )
3798#if defined( __netcdf )
3799
3800       USE indices
3801       USE pegrid
3802
3803       IMPLICIT NONE
3804
3805       CHARACTER(LEN=*)              ::  variable_name   !< variable name
3806
3807       INTEGER(iwp), INTENT(IN)      ::  i               !< index along x direction
3808       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
3809       INTEGER(iwp)                  ::  id_var          !< variable id
3810       INTEGER(iwp), INTENT(IN)      ::  j               !< index along y direction
3811       INTEGER(iwp)                  ::  n3              !< number of data-points along 3rd dimension
3812
3813       INTEGER(iwp), DIMENSION(3)    ::  id_dim
3814
3815       REAL(wp), DIMENSION(:), INTENT(INOUT) ::  var     !< variable to be read
3816
3817!
3818!--    Inquire variable id
3819       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
3820!
3821!--    Get length of first dimension, required for the count parameter.
3822!--    Therefore, first inquired dimension ids
3823       nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, DIMIDS = id_dim )
3824       nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(3), LEN = n3 )
3825!
3826!--    Get variable
3827       nc_stat = NF90_GET_VAR( id, id_var, var,                                &
3828                               start = (/ i+1, j+1, 1 /),                      &
3829                               count = (/ 1, 1, n3 /) )
3830
3831       CALL handle_error( 'get_variable_3d_real', 532 )
3832#endif
3833    END SUBROUTINE get_variable_3d_real
3834
3835
3836!------------------------------------------------------------------------------!
3837! Description:
3838! ------------
3839!> Reads a 4D float variable from file. Note, in constrast to 3D versions,
3840!> dimensions are already inquired and passed so that they are known here.
3841!------------------------------------------------------------------------------!
3842    SUBROUTINE get_variable_4d_real( id, variable_name, i, j, var, n3, n4 )
3843#if defined( __netcdf )
3844
3845       USE indices
3846       USE pegrid
3847
3848       IMPLICIT NONE
3849
3850       CHARACTER(LEN=*)              ::  variable_name   !< variable name
3851
3852       INTEGER(iwp), INTENT(IN)      ::  i               !< index along x direction
3853       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
3854       INTEGER(iwp)                  ::  id_var          !< variable id
3855       INTEGER(iwp), INTENT(IN)      ::  j               !< index along y direction
3856       INTEGER(iwp), INTENT(IN)      ::  n3              !< number of data-points along 3rd dimension
3857       INTEGER(iwp), INTENT(IN)      ::  n4              !< number of data-points along 4th dimension
3858
3859       INTEGER(iwp), DIMENSION(3)    ::  id_dim
3860
3861       REAL(wp), DIMENSION(:,:), INTENT(INOUT) ::  var     !< variable to be read
3862
3863!
3864!--    Inquire variable id
3865       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
3866!
3867!--    Get variable
3868       nc_stat = NF90_GET_VAR( id, id_var, var,                                &
3869                               start = (/ i+1, j+1, 1, 1 /),                   &
3870                               count = (/ 1, 1, n3, n4 /) )
3871
3872       CALL handle_error( 'get_variable_4d_real', 533 )
3873#endif
3874    END SUBROUTINE get_variable_4d_real
3875
3876
3877
3878!------------------------------------------------------------------------------!
3879! Description:
3880! ------------
3881!> Reads a 3D float variable at left, right, north, south and top boundaries.
3882!------------------------------------------------------------------------------!
3883    SUBROUTINE get_variable_bc( id, variable_name, t_start,                    &
3884                                i2_s, count_2, i3_s, count_3,  var )
3885#if defined( __netcdf )
3886
3887       USE indices
3888       USE pegrid
3889
3890       IMPLICIT NONE
3891
3892       CHARACTER(LEN=*)              ::  variable_name   !< variable name
3893
3894       INTEGER(iwp)                  ::  count_2         !< number of elements in second dimension
3895       INTEGER(iwp)                  ::  count_3         !< number of elements in third dimension (usually 1)
3896       INTEGER(iwp)                  ::  i2_s            !< start index of second dimension
3897       INTEGER(iwp)                  ::  i3_s            !< start index of third dimension
3898       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
3899       INTEGER(iwp)                  ::  id_var          !< variable id
3900       INTEGER(iwp)                  ::  t_start         !< start index at time dimension with respect to netcdf convention
3901
3902       REAL(wp), DIMENSION(:), INTENT(INOUT) ::  var     !< input variable
3903
3904!
3905!--    Inquire variable id
3906       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
3907!
3908!--    Get variable
3909       nc_stat = NF90_GET_VAR( id, id_var, var,                              &
3910                               start = (/ i3_s, i2_s, t_start /),            & 
3911                               count = (/ count_3, count_2, 1 /) )       
3912
3913       CALL handle_error( 'get_variable_bc', 532 )
3914#endif
3915    END SUBROUTINE get_variable_bc
3916
3917
3918
3919!------------------------------------------------------------------------------!
3920! Description:
3921! ------------
3922!> Inquires the number of variables in a file 
3923!------------------------------------------------------------------------------!
3924    SUBROUTINE inquire_num_variables( id, num_vars )
3925#if defined( __netcdf )
3926
3927       USE indices
3928       USE pegrid
3929
3930       IMPLICIT NONE
3931
3932       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
3933       INTEGER(iwp), INTENT(INOUT)   ::  num_vars        !< number of variables in a file
3934
3935       nc_stat = NF90_INQUIRE( id, NVARIABLES = num_vars )
3936       CALL handle_error( 'inquire_num_variables', 534 )
3937
3938#endif
3939    END SUBROUTINE inquire_num_variables
3940
3941
3942!------------------------------------------------------------------------------!
3943! Description:
3944! ------------
3945!> Inquires the variable names belonging to a file.
3946!------------------------------------------------------------------------------!
3947    SUBROUTINE inquire_variable_names( id, var_names )
3948#if defined( __netcdf )
3949
3950       USE indices
3951       USE pegrid
3952
3953       IMPLICIT NONE
3954
3955       CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) ::  var_names   !< return variable - variable names
3956       INTEGER(iwp)                                  ::  i           !< loop variable
3957       INTEGER(iwp), INTENT(IN)                      ::  id          !< file id
3958       INTEGER(iwp)                                  ::  num_vars    !< number of variables (unused return parameter)
3959       INTEGER(iwp), DIMENSION(:), ALLOCATABLE       ::  varids      !< dummy array to strore variable ids temporarily
3960
3961       ALLOCATE( varids(1:SIZE(var_names)) )
3962       nc_stat = NF90_INQ_VARIDS( id, NVARS = num_vars, VARIDS = varids )
3963       CALL handle_error( 'inquire_variable_names', 535 )
3964
3965       DO  i = 1, SIZE(var_names)
3966          nc_stat = NF90_INQUIRE_VARIABLE( id, varids(i), NAME = var_names(i) )
3967          CALL handle_error( 'inquire_variable_names', 535 )
3968       ENDDO
3969
3970       DEALLOCATE( varids )
3971#endif
3972    END SUBROUTINE inquire_variable_names
3973
3974!------------------------------------------------------------------------------!
3975! Description:
3976! ------------
3977!> Prints out a text message corresponding to the current status.
3978!------------------------------------------------------------------------------!
3979    SUBROUTINE handle_error( routine_name, errno )
3980#if defined( __netcdf )
3981
3982       USE control_parameters,                                                 &
3983           ONLY:  message_string
3984
3985       IMPLICIT NONE
3986
3987       CHARACTER(LEN=6) ::  message_identifier
3988       CHARACTER(LEN=*) ::  routine_name
3989
3990       INTEGER(iwp) ::  errno
3991
3992       IF ( nc_stat /= NF90_NOERR )  THEN
3993
3994          WRITE( message_identifier, '(''NC'',I4.4)' )  errno
3995          message_string = TRIM( NF90_STRERROR( nc_stat ) )
3996
3997          CALL message( routine_name, message_identifier, 2, 2, 0, 6, 1 )
3998
3999       ENDIF
4000
4001#endif
4002    END SUBROUTINE handle_error
4003
4004
4005 END MODULE netcdf_data_input_mod
Note: See TracBrowser for help on using the repository browser.