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

Last change on this file since 2946 was 2946, checked in by suehring, 3 years ago

Bugfix for revision 2945, perform checks only if dynamic input file is available; remove unused module load

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