Changeset 4767 for palm/trunk/SOURCE
- Timestamp:
- Nov 2, 2020 3:44:16 PM (3 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/netcdf_data_input_mod.f90 (modified) (33 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/netcdf_data_input_mod.f90
r4724 r4767 1 1 !> @file netcdf_data_input_mod.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 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/>. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 8 ! 9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 12 ! 13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 16 15 ! 17 16 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------ !17 !--------------------------------------------------------------------------------------------------! 19 18 ! 20 19 ! Current revisions: … … 25 24 ! ----------------- 26 25 ! $Id$ 26 ! file re-formatted to follow the PALM coding standard 27 ! 28 ! 4724 2020-10-06 17:20:39Z suehring 27 29 ! - New routines to read LOD=1 variables from dynamic input file 28 30 ! - add no_abort option to all get_attribute routines … … 30 32 ! 4641 2020-08-13 09:57:07Z suehring 31 33 ! To follow (UC)2 standard, change default of attribute data_content 32 ! 34 ! 33 35 ! 4507 2020-04-22 18:21:45Z gronemeier 34 36 ! - bugfix: check terrain height for fill values directly after reading 35 ! - changes: 37 ! - changes: 36 38 ! - remove check for negative zt 37 39 ! - add reference height from input file upon PALM reference height (origin_z) 38 ! 40 ! 39 41 ! 4457 2020-03-11 14:20:43Z raasch 40 42 ! use statement for exchange horiz added, 41 43 ! bugfixes for calls of exchange horiz 2d 42 ! 44 ! 43 45 ! 4435 2020-03-03 10:38:41Z raasch 44 46 ! temporary bugfix to avoid compile problems with older NetCDFD libraries on IMUK machines 45 ! 47 ! 46 48 ! 4434 2020-03-03 10:02:18Z oliver.maas 47 49 ! added optional netcdf data input for wtm array input parameters 48 ! 50 ! 49 51 ! 4404 2020-02-12 17:01:53Z suehring 50 52 ! Fix misplaced preprocessor directives. 51 ! 53 ! 52 54 ! 4401 2020-02-11 16:19:09Z suehring 53 ! Define a default list of coordinate reference system variables used when 54 ! no static driver input isavailable55 ! 55 ! Define a default list of coordinate reference system variables used when no static driver input is 56 ! available 57 ! 56 58 ! 4400 2020-02-10 20:32:41Z suehring 57 59 ! - Routine to inquire default fill values added 58 60 ! - netcdf_data_input_att and netcdf_data_input_var routines removed 59 ! 61 ! 60 62 ! 4392 2020-01-31 16:14:57Z pavelkrc 61 63 ! (resler) Decrease length of reading buffer (fix problem of ifort/icc compilers) 62 ! 64 ! 63 65 ! 4389 2020-01-29 08:22:42Z raasch 64 66 ! Error messages refined for reading ASCII topo file, also reading of topo file revised so that 65 67 ! statement labels and goto statements are not required any more 66 ! 68 ! 67 69 ! 4388 2020-01-28 16:36:55Z raasch 68 70 ! bugfix for error messages while reading ASCII topo file 69 ! 71 ! 70 72 ! 4387 2020-01-28 11:44:20Z banzhafs 71 ! Added subroutine get_variable_string_generic ( ) 72 ! and added to interface get_variable to circumvent 73 ! unknown application-specific restrictions 74 ! in existing function get_variable_string ( ), 75 ! which is retained for backward compatibility (ECC) 73 ! Added subroutine get_variable_string_generic ( ) and added to interface get_variable to circumvent 74 ! unknown application-specific restrictions in existing function get_variable_string ( ), which is 75 ! retained for backward compatibility (ECC) 76 76 ! 77 77 ! 4370 2020-01-10 14:00:44Z raasch … … 79 79 ! 80 80 ! 4362 2020-01-07 17:15:02Z suehring 81 ! Input of plant canopy variables from static driver moved to plant-canopy 82 ! model 83 ! 81 ! Input of plant canopy variables from static driver moved to plant-canopy model 82 ! 84 83 ! 4360 2020-01-07 11:25:50Z suehring 85 ! Correct single message calls, local checks must be given by the respective 86 ! mpi rank. 87 ! 84 ! Correct single message calls, local checks must be given by the respective mpi rank. 85 ! 88 86 ! 4346 2019-12-18 11:55:56Z motisi 89 ! Introduction of wall_flags_total_0, which currently sets bits based on static 90 ! topographyinformation used in wall_flags_static_091 ! 87 ! Introduction of wall_flags_total_0, which currently sets bits based on static topography 88 ! information used in wall_flags_static_0 89 ! 92 90 ! 4329 2019-12-10 15:46:36Z motisi 93 91 ! Renamed wall_flags_0 to wall_flags_static_0 94 ! 92 ! 95 93 ! 4321 2019-12-04 10:26:38Z pavelkrc 96 94 ! Further revise check for surface fractions 97 ! 95 ! 98 96 ! 4313 2019-11-27 14:07:00Z suehring 99 97 ! Checks for surface fractions revised 100 ! 98 ! 101 99 ! 4312 2019-11-27 14:06:25Z suehring 102 100 ! Open input files with read-only attribute instead of write attribute. 103 ! 101 ! 104 102 ! 4280 2019-10-29 14:34:15Z monakurppa 105 ! Remove id_emis flags from get_variable_4d_to_3d_real and 106 ! get_variable_5d_to_4d_real 107 ! 103 ! Remove id_emis flags from get_variable_4d_to_3d_real and get_variable_5d_to_4d_real 104 ! 108 105 ! 4258 2019-10-07 13:29:08Z suehring 109 106 ! - Migrate input of soil temperature and moisture to land-surface model. 110 ! - Remove interpolate routines and move the only required subroutine to 111 ! land-surface model. 112 ! 107 ! - Remove interpolate routines and move the only required subroutine to land-surface model. 108 ! 113 109 ! 4247 2019-09-30 10:18:24Z pavelkrc 114 110 ! Add reading and processing of building_surface_pars 115 ! 111 ! 116 112 ! 4226 2019-09-10 17:03:24Z suehring 117 113 ! - Netcdf input routine for dimension length renamed 118 114 ! - Move offline-nesting-specific checks to nesting_offl_mod 119 ! - Module-specific input of boundary data for offline nesting moved to 120 ! nesting_offl_mod 115 ! - Module-specific input of boundary data for offline nesting moved to nesting_offl_mod 121 116 ! - Define module specific data type for offline nesting in nesting_offl_mod 122 ! 117 ! 123 118 ! 4190 2019-08-27 15:42:37Z suehring 124 119 ! type real_1d changed to real_1d_3d 125 ! 120 ! 126 121 ! 4186 2019-08-23 16:06:14Z suehring 127 122 ! Minor formatting adjustments 128 ! 123 ! 129 124 ! 4182 2019-08-22 15:20:23Z scharf 130 125 ! Corrected "Former revisions" section 131 ! 126 ! 132 127 ! 4178 2019-08-21 11:13:06Z suehring 133 ! Implement input of external radiation forcing. Therefore, provide public 134 ! subroutines and variables.135 ! 128 ! Implement input of external radiation forcing. Therefore, provide public subroutines and 129 ! variables. 130 ! 136 131 ! 4150 2019-08-08 20:00:47Z suehring 137 ! Some variables are given the public attribute, in order to call netcdf input 138 ! from single routines 139 ! 132 ! Some variables are given the public attribute, in order to call netcdf input from single routines 133 ! 140 134 ! 4125 2019-07-29 13:31:44Z suehring 141 ! To enable netcdf-parallel access for lateral boundary data (dynamic input), 142 ! zero number of elements are passed to the respective get_variable routine 143 ! for non-boundary cores. 144 ! 135 ! To enable netcdf-parallel access for lateral boundary data (dynamic input), zero number of 136 ! elements are passed to the respective get_variable routine for non-boundary cores. 137 ! 145 138 ! 4100 2019-07-17 08:11:29Z forkel 146 139 ! Made check for input_pids_dynamic and 'inifor' more general 147 ! 140 ! 148 141 ! 4012 2019-05-31 15:19:05Z monakurppa 149 ! 142 ! 150 143 ! 3994 2019-05-22 18:08:09Z suehring 151 144 ! Remove single location message 152 ! 145 ! 153 146 ! 3976 2019-05-15 11:02:34Z hellstea 154 147 ! Remove unused variables from last commit 155 ! 148 ! 156 149 ! 3969 2019-05-13 12:14:33Z suehring 157 150 ! - clean-up index notations for emission_values to eliminate magic numbers 158 ! - introduce temporary variable dum_var_5d as well as subroutines 159 ! get_var_5d_real and get_var_5d_real_dynamic151 ! - introduce temporary variable dum_var_5d as well as subroutines get_var_5d_real and 152 ! get_var_5d_real_dynamic 160 153 ! - remove emission-specific code in generic get_variable routines 161 ! - in subroutine netcdf_data_input_chemistry_data change netCDF LOD 1 162 ! (default) emission_values to the following index order: 163 ! z, y, x, species, category 164 ! - in subroutine netcdf_data_input_chemistry_data 165 ! changed netCDF LOD 2 pre-processed emission_values to the following index 166 ! order: time, z, y, x, species 167 ! - in type chem_emis_att_type replace nspec with n_emiss_species 168 ! but retained nspec for backward compatibility with salsa_mod. (E.C. Chan) 169 ! 154 ! - in subroutine netcdf_data_input_chemistry_data change netCDF LOD 1 (default) emission_values to 155 ! the following index order: z, y, x, species, category 156 ! - in subroutine netcdf_data_input_chemistry_data changed netCDF LOD 2 pre-processed 157 ! emission_values to the following index order: time, z, y, x, species 158 ! - in type chem_emis_att_type replace nspec with n_emiss_species but retained nspec for backward 159 ! compatibility with salsa_mod. (E.C. Chan) 160 ! 170 161 ! 3961 2019-05-08 16:12:31Z suehring 171 162 ! Revise checks for building IDs and types 172 ! 163 ! 173 164 ! 3943 2019-05-02 09:50:41Z maronga 174 165 ! Temporarily disabled some (faulty) checks for static driver. 175 ! 166 ! 176 167 ! 3942 2019-04-30 13:08:30Z kanani 177 ! Fix: increase LEN of all NetCDF attribute values (caused crash in 178 ! netcdf_create_global_atts due toinsufficient length)179 ! 168 ! Fix: increase LEN of all NetCDF attribute values (caused crash in netcdf_create_global_atts due to 169 ! insufficient length) 170 ! 180 171 ! 3941 2019-04-30 09:48:33Z suehring 181 ! Move check for grid dimension to an earlier point in time when first array 182 ! is read. 172 ! Move check for grid dimension to an earlier point in time when first array is read. 183 173 ! Improve checks for building types / IDs with respect to 2D/3D buildings. 184 ! 174 ! 185 175 ! 3885 2019-04-11 11:29:34Z kanani 186 ! Changes related to global restructuring of location messages and introduction 187 ! of additional debugmessages188 ! 176 ! Changes related to global restructuring of location messages and introduction of additional debug 177 ! messages 178 ! 189 179 ! 3864 2019-04-05 09:01:56Z monakurppa 190 ! get_variable_4d_to_3d_real modified to enable read in data of type 191 ! data(t,y,x,n) one timestep ata time + some routines made public192 ! 180 ! get_variable_4d_to_3d_real modified to enable read in data of type data(t,y,x,n) one timestep at 181 ! a time + some routines made public 182 ! 193 183 ! 3855 2019-04-03 10:00:59Z suehring 194 184 ! Typo removed 195 ! 185 ! 196 186 ! 3854 2019-04-02 16:59:33Z suehring 197 187 ! Bugfix in one of the checks. Typo removed. 198 ! 188 ! 199 189 ! 3744 2019-02-15 18:38:58Z suehring 200 ! Enable mesoscale offline nesting for chemistry variables as well as 201 ! initialization of chemistryvia dynamic input file.202 ! 190 ! Enable mesoscale offline nesting for chemistry variables as well as initialization of chemistry 191 ! via dynamic input file. 192 ! 203 193 ! 3705 2019-01-29 19:56:39Z suehring 204 ! Interface for attribute input of 8-bit and 32-bit integer 205 ! 194 ! Interface for attribute input of 8-bit and 32-bit integer 195 ! 206 196 ! 3704 2019-01-29 19:51:41Z suehring 207 197 ! unused variables removed 208 ! 198 ! 209 199 ! 2696 2017-12-14 17:12:51Z kanani 210 200 ! Initial revision (suehring) … … 220 210 !> Modulue contains routines to input data according to Palm input data 221 211 !> standart using dynamic and static input files. 222 !> @todo - Chemistry: revise reading of netcdf file and ajdust formatting 223 !> according to standard!!!(ecc/done)212 !> @todo - Chemistry: revise reading of netcdf file and ajdust formatting according to standard!!! 213 !> (ecc/done) 224 214 !> @todo - Order input alphabetically 225 215 !> @todo - Revise error messages and error numbers 226 216 !> @todo - Input of missing quantities (chemical species, emission rates) 227 !> @todo - Defninition and input of still missing variable attributes 228 !> (ecc/what are they?) 217 !> @todo - Definition and input of still missing variable attributes (ecc/what are they?) 229 218 !> @todo - Input of initial geostrophic wind profiles with cyclic conditions. 230 !> @todo - remove z dimension from default_emission_data nad preproc_emission_data 231 ! and correpsondingsubroutines get_var_5d_real and get_var_5d_dynamic (ecc)219 !> @todo - remove z dimension from default_emission_data nad preproc_emission_data and correpsonding 220 !> subroutines get_var_5d_real and get_var_5d_dynamic (ecc) 232 221 !> @todo - decpreciate chem_emis_att_type@nspec (ecc) 233 !> @todo - depreciate subroutines get_variable_4d_to_3d_real and 234 !> get_variable_5d_to_4d_real (ecc) 222 !> @todo - depreciate subroutines get_variable_4d_to_3d_real and get_variable_5d_to_4d_real (ecc) 235 223 !> @todo - introduce useful debug_message(s) 236 !------------------------------------------------------------------------------ !224 !--------------------------------------------------------------------------------------------------! 237 225 MODULE netcdf_data_input_mod 238 226 239 USE control_parameters, &227 USE control_parameters, & 240 228 ONLY: coupling_char, io_blocks, io_group 241 229 242 USE cpulog, &230 USE cpulog, & 243 231 ONLY: cpu_log, log_point_s 244 232 245 USE indices, &233 USE indices, & 246 234 ONLY: nbgp 247 235 … … 254 242 USE pegrid 255 243 256 USE surface_mod, &244 USE surface_mod, & 257 245 ONLY: ind_pav_green, ind_veg_wall, ind_wat_win 258 246 ! … … 266 254 REAL(wp), DIMENSION(:), ALLOCATABLE :: z !< dimension array in z 267 255 END TYPE dims_xy 256 268 257 TYPE init_type 269 258 270 CHARACTER(LEN=16) :: init_char = 'init_atmosphere_' !< leading substring for init variables 271 CHARACTER(LEN=23) :: origin_time = '2000-01-01 00:00:00 +00' !< reference time of input data 272 CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names_chem !< list of chemistry variable names that can potentially be on file 259 CHARACTER(LEN=16) :: init_char = 'init_atmosphere_' !< leading substring for init variables 260 CHARACTER(LEN=23) :: origin_time = '2000-01-01 00:00:00 +00' !< reference time of input data 261 262 CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names_chem !< list of chemistry variable names that can potentially be 263 !< on file 273 264 274 265 INTEGER(iwp) :: lod_msoil !< level of detail - soil moisture … … 286 277 INTEGER(iwp) :: nzu !< number of vertical levels on scalar grid in dynamic input file 287 278 INTEGER(iwp) :: nzw !< number of vertical levels on w grid in dynamic input file 288 279 289 280 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: lod_chem !< level of detail - chemistry variables 290 281 … … 298 289 LOGICAL :: from_file_vg = .FALSE. !< flag indicating whether ug is already initialized from file 299 290 LOGICAL :: from_file_w = .FALSE. !< flag indicating whether w is already initialized from file 300 291 301 292 LOGICAL, DIMENSION(:), ALLOCATABLE :: from_file_chem !< flag indicating whether chemistry variable is read from file 302 293 … … 326 317 REAL(wp), DIMENSION(:), ALLOCATABLE :: w_init !< initial vertical profile of w 327 318 REAL(wp), DIMENSION(:), ALLOCATABLE :: z_soil !< vertical levels in soil in dynamic input file, used for interpolation 328 REAL(wp), DIMENSION(:), ALLOCATABLE :: zu_atmos !< vertical levels at scalar grid in dynamic input file, used for interpolation 329 REAL(wp), DIMENSION(:), ALLOCATABLE :: zw_atmos !< vertical levels at w grid in dynamic input file, used for interpolation 330 319 REAL(wp), DIMENSION(:), ALLOCATABLE :: zu_atmos !< vertical levels at scalar grid in dynamic input file, used for 320 !< interpolation 321 REAL(wp), DIMENSION(:), ALLOCATABLE :: zw_atmos !< vertical levels at w grid in dynamic input file, used for 322 !< interpolation 323 331 324 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: chem_init !< initial vertical profiles of chemistry variables 332 325 333 326 334 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: msoil_3d !< initial 3d soil moisture provide by Inifor and interpolated onto soil grid 335 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tsoil_3d !< initial 3d soil temperature provide by Inifor and interpolated onto soil grid 327 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: msoil_3d !< initial 3d soil moisture provide by Inifor and interpolated onto 328 !< soil grid 329 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tsoil_3d !< initial 3d soil temperature provide by Inifor and interpolated onto 330 !< soil grid 336 331 337 332 END TYPE init_type 338 333 ! 339 334 !-- Data type for the general information of chemistry emissions, do not dependent on the particular chemical species 340 TYPE chem_emis_att_type 341 342 !-DIMENSIONS 343 335 TYPE chem_emis_att_type 336 ! 337 !-- DIMENSIONS 344 338 INTEGER(iwp) :: nspec=0 !< no of chem species provided in emission_values 345 339 INTEGER(iwp) :: n_emiss_species=0 !< no of chem species provided in emission_values 346 340 !< same function as nspec, which will be depreciated (ecc) 347 348 341 INTEGER(iwp) :: ncat=0 !< number of emission categories 349 342 INTEGER(iwp) :: nvoc=0 !< number of VOC components … … 353 346 INTEGER(iwp) :: nhoursyear !< number of hours of a specific year in the HOURLY mode 354 347 !< of the default mode 355 INTEGER(iwp) :: nmonthdayhour !< number of month days and hours in the MDH mode 348 INTEGER(iwp) :: nmonthdayhour !< number of month days and hours in the MDH mode 356 349 !< of the default mode 357 INTEGER(iwp) :: dt_emission !< Number of emissions timesteps for one year 350 INTEGER(iwp) :: dt_emission !< Number of emissions timesteps for one year 358 351 !< in the pre-processed emissions case 359 !-- 1d emission input variables 352 ! 353 !-- 1d emission input variables 360 354 CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: pm_name !< Names of PM components 361 355 CHARACTER (LEN=25),ALLOCATABLE, DIMENSION(:) :: cat_name !< Emission category names … … 364 358 CHARACTER (LEN=25) :: units !< Units 365 359 366 INTEGER(iwp) :: i_hour !< indices for assigning emission values at different timesteps 360 INTEGER(iwp) :: i_hour !< indices for assigning emission values at different 361 !< timesteps 367 362 INTEGER(iwp),ALLOCATABLE, DIMENSION(:) :: cat_index !< Indices for emission categories 368 363 INTEGER(iwp),ALLOCATABLE, DIMENSION(:) :: species_index !< Indices for emission chem species … … 370 365 REAL(wp),ALLOCATABLE, DIMENSION(:) :: xm !< Molecular masses of emission chem species 371 366 372 !-- 2d emission input variables 367 !-- 2d emission input variables 373 368 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: hourly_emis_time_factor !< Time factors for HOURLY emissions (DEFAULT mode) 374 369 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: mdh_emis_time_factor !< Time factors for MDH emissions (DEFAULT mode) 375 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: nox_comp !< Composition of NO and NO2 370 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: nox_comp !< Composition of NO and NO2 376 371 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: sox_comp !< Composition of SO2 and SO4 377 372 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: voc_comp !< Composition of VOC components (not fixed) 378 373 379 !--3d emission input variables380 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: pm_comp !< Composition of PM components (not fixed) 381 374 !-- 3d emission input variables 375 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: pm_comp !< Composition of PM components (not fixed) 376 382 377 END TYPE chem_emis_att_type 383 378 384 379 385 380 !-- Data type for the values of chemistry emissions 386 TYPE chem_emis_val_type 381 TYPE chem_emis_val_type 387 382 388 383 !REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: stack_height !< stack height (ecc / to be implemented) … … 399 394 INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE :: var !< respective variable 400 395 401 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used 396 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default 397 !< values are used 402 398 END TYPE int_2d_8bit 403 399 ! … … 407 403 INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: var_3d !< respective variable 408 404 409 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used 405 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default 406 !< values are used 410 407 END TYPE int_3d_8bit 411 408 ! … … 415 412 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: var !< respective variable 416 413 417 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used 414 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default 415 !< values are used 418 416 END TYPE int_2d_32bit 419 417 ! 420 !-- Define data type to read 1D or 3D real variables. 418 !-- Define data type to read 1D or 3D real variables. 421 419 TYPE real_1d_3d 422 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used 420 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default 421 !< values are used 423 422 424 423 INTEGER(iwp) :: lod = -1 !< level-of-detail 425 424 426 425 REAL(wp) :: fill = -9999.9_wp !< fill value 427 426 428 427 REAL(wp), DIMENSION(:), ALLOCATABLE :: var1d !< respective 1D variable 429 428 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: var3d !< respective 3D variable 430 END TYPE real_1d_3d 429 END TYPE real_1d_3d 431 430 ! 432 431 !-- Define data type to read 2D real variables 433 432 TYPE real_2d 434 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used 433 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default 434 !< values are used 435 435 436 436 INTEGER(iwp) :: lod !< level-of-detail 437 438 REAL(wp) :: fill = -9999.9_wp !< fill value439 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: var !< respective variable437 438 REAL(wp) :: fill = -9999.9_wp !< fill value 439 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: var !< respective variable 440 440 END TYPE real_2d 441 441 … … 443 443 !-- Define data type to read 3D real variables 444 444 TYPE real_3d 445 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used 445 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default 446 !< values are used 446 447 447 448 INTEGER(iwp) :: nz !< number of grid points along vertical dimension 448 449 449 REAL(wp) :: fill = -9999.9_wp !< fill value450 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: var !< respective variable450 REAL(wp) :: fill = -9999.9_wp !< fill value 451 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: var !< respective variable 451 452 END TYPE real_3d 452 453 ! 453 !-- Define data structure where the dimension and type of the input depends 454 !-- on the given level ofdetail.454 !-- Define data structure where the dimension and type of the input depends on the given level of 455 !-- detail. 455 456 !-- For buildings, the input is either 2D float, or 3d byte. 456 457 TYPE build_in … … 462 463 REAL(wp), DIMENSION(:), ALLOCATABLE :: z !< vertical coordinate for 3D building, used for consistency check 463 464 464 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used 465 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default 466 !< values are used 465 467 466 468 REAL(wp) :: fill1 = -9999.9_wp !< fill values for lod = 1 … … 477 479 INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: var_3d !< 3d variable (lod = 2) 478 480 479 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used 481 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default 482 !< values are used 480 483 END TYPE soil_in 481 484 … … 486 489 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: nfracs !< dimension array for fraction 487 490 488 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used 489 490 REAL(wp) :: fill = -9999.9_wp !< fill value 491 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: frac !< respective fraction between different surface types 491 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default 492 !< values are used 493 494 REAL(wp) :: fill = -9999.9_wp !< fill value 495 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: frac !< respective fraction between different surface types 492 496 END TYPE fracs 493 497 ! 494 !-- Data type for parameter lists, Depending on the given level of detail, 495 !-- the input is 3D or 4D 498 !-- Data type for parameter lists, Depending on the given level of detail, the input is 3D or 4D 496 499 TYPE pars 497 500 INTEGER(iwp) :: lod = 1 !< level of detail … … 501 504 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: pars !< dimension array for parameters 502 505 503 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used 506 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default 507 !< values are used 504 508 505 509 REAL(wp) :: fill = -9999.9_wp !< fill value … … 517 521 !< norm_z,norm_y,norm_x: surface normal vector 518 522 519 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default values are used 523 LOGICAL :: from_file = .FALSE. !< flag indicating whether an input variable is available and read from file or default 524 !< values are used 520 525 521 526 REAL(wp) :: fill = -9999.9_wp !< fill value … … 524 529 ! 525 530 !-- Define type for global file attributes 526 !-- Please refer to the PALM data standard for a detailed description of each 527 !-- attribute. 531 !-- Please refer to the PALM data standard for a detailed description of each attribute. 528 532 TYPE global_atts_type 529 533 CHARACTER(LEN=200) :: acronym = ' ' !< acronym of institution … … 593 597 CHARACTER(LEN=200) :: units = 'm' !< unit of crs 594 598 595 REAL(wp) :: false_easting = 500000.0_wp !< false easting596 REAL(wp) :: false_northing = 0.0_wp !< false northing597 REAL(wp) :: inverse_flattening = 298.257223563_wp !< 1/f (default for WGS84)598 REAL(wp) :: latitude_of_projection_origin = 0.0_wp !< latitude of projection origin599 REAL(wp) :: longitude_of_central_meridian = 3.0_wp !< longitude of central meridian of UTM zone (default: zone 31)600 REAL(wp) :: longitude_of_prime_meridian = 0.0_wp !< longitude of prime meridian601 REAL(wp) :: scale_factor_at_central_meridian = 0.9996_wp !< scale factor of UTM coordinates602 REAL(wp) :: semi_major_axis = 6378137.0_wp !< length of semi major axis (default for WGS84)599 REAL(wp) :: false_easting = 500000.0_wp !< false easting 600 REAL(wp) :: false_northing = 0.0_wp !< false northing 601 REAL(wp) :: inverse_flattening = 298.257223563_wp !< 1/f (default for WGS84) 602 REAL(wp) :: latitude_of_projection_origin = 0.0_wp !< latitude of projection origin 603 REAL(wp) :: longitude_of_central_meridian = 3.0_wp !< longitude of central meridian of UTM zone (default: zone 31) 604 REAL(wp) :: longitude_of_prime_meridian = 0.0_wp !< longitude of prime meridian 605 REAL(wp) :: scale_factor_at_central_meridian = 0.9996_wp !< scale factor of UTM coordinates 606 REAL(wp) :: semi_major_axis = 6378137.0_wp !< length of semi major axis (default for WGS84) 603 607 END TYPE crs_type 604 608 605 609 ! 606 610 !-- Define variables 607 TYPE(crs_type) 608 609 TYPE(dims_xy) :: dim_static !< data structure for x, y-dimension in static input file610 611 TYPE(init_type) :: init_3d !< data structure for the initialization of the 3D flow and soil fields612 TYPE(init_type) :: init_model !< data structure for the initialization of the model611 TYPE(crs_type) :: coord_ref_sys !< coordinate reference system 612 613 TYPE(dims_xy) :: dim_static !< data structure for x, y-dimension in static input file 614 615 TYPE(init_type) :: init_3d !< data structure for the initialization of the 3D flow and soil fields 616 TYPE(init_type) :: init_model !< data structure for the initialization of the model 613 617 614 618 ! … … 657 661 TYPE(pars_surf) :: building_surface_pars_f !< input variable for building surface parameters 658 662 659 TYPE(chem_emis_att_type) :: chem_emis_att !< Input Information of Chemistry Emission Data from netcdf 660 TYPE(chem_emis_val_type), ALLOCATABLE, DIMENSION(:) :: chem_emis !< Input Chemistry Emission Data from netcdf 663 TYPE(chem_emis_att_type) :: chem_emis_att !< Input Information of Chemistry Emission Data from 664 !< netcdf 665 TYPE(chem_emis_val_type), ALLOCATABLE, DIMENSION(:) :: chem_emis !< Input Chemistry Emission Data from netcdf 661 666 662 667 CHARACTER(LEN=3) :: char_lod = 'lod' !< name of level-of-detail attribute in NetCDF file … … 670 675 CHARACTER(LEN=100) :: input_file_vm = 'PIDS_VM' !< Name of file which comprises virtual measurement data 671 676 CHARACTER(LEN=100) :: input_file_wtm = 'PIDS_WTM' !< Name of file which comprises wind turbine model input data 672 673 CHARACTER(LEN=25), ALLOCATABLE, DIMENSION(:):: string_values !< output of string variables read from netcdf input files677 678 CHARACTER(LEN=25), DIMENSION(:), ALLOCATABLE :: string_values !< output of string variables read from netcdf input files 674 679 CHARACTER(LEN=50), DIMENSION(:), ALLOCATABLE :: vars_pids !< variable in input file 675 680 676 INTEGER(iwp) :: id_emis !< NetCDF id of input file for chemistry emissions: TBD: It has to be removed 681 INTEGER(iwp) :: id_emis !< NetCDF id of input file for chemistry emissions: TBD: It 682 !< has to be removed 677 683 678 684 INTEGER(iwp) :: nc_stat !< return value of nf90 function call … … 680 686 INTEGER(iwp) :: pids_id !< file id 681 687 682 LOGICAL :: input_pids_static = .FALSE. !< Flag indicating whether Palm-input-data-standard file containing static information exists 683 LOGICAL :: input_pids_dynamic = .FALSE. !< Flag indicating whether Palm-input-data-standard file containing dynamic information exists 684 LOGICAL :: input_pids_chem = .FALSE. !< Flag indicating whether Palm-input-data-standard file containing chemistry information exists 685 LOGICAL :: input_pids_uvem = .FALSE. !< Flag indicating whether uv-expoure-model input file containing static information exists 688 LOGICAL :: input_pids_static = .FALSE. !< Flag indicating whether Palm-input-data-standard file containing static 689 !< information exists 690 LOGICAL :: input_pids_dynamic = .FALSE. !< Flag indicating whether Palm-input-data-standard file containing dynamic 691 !< information exists 692 LOGICAL :: input_pids_chem = .FALSE. !< Flag indicating whether Palm-input-data-standard file containing chemistry 693 !< information exists 694 LOGICAL :: input_pids_uvem = .FALSE. !< Flag indicating whether uv-expoure-model input file containing static information 695 !< exists 686 696 LOGICAL :: input_pids_vm = .FALSE. !< Flag indicating whether input file for virtual measurements exist 687 697 LOGICAL :: input_pids_wtm = .FALSE. !< Flag indicating whether input file for wind turbine model exists … … 729 739 MODULE PROCEDURE netcdf_data_input_init_3d 730 740 END INTERFACE netcdf_data_input_init_3d 731 741 732 742 INTERFACE netcdf_data_input_surface_data 733 743 MODULE PROCEDURE netcdf_data_input_surface_data … … 772 782 ! 773 783 !-- Public data structures 774 PUBLIC real_1d_3d, &775 real_2d, &784 PUBLIC real_1d_3d, & 785 real_2d, & 776 786 real_3d 777 787 ! 778 788 !-- Public variables 779 PUBLIC albedo_pars_f, albedo_type_f, buildings_f, & 780 building_id_f, building_pars_f, building_surface_pars_f, & 781 building_type_f, & 782 char_fill, & 783 char_lod, & 784 chem_emis, chem_emis_att, chem_emis_att_type, chem_emis_val_type, & 785 coord_ref_sys, & 786 crs_list, & 787 init_3d, init_model, input_file_atts, & 788 input_file_dynamic, & 789 input_file_static, & 790 input_pids_static, & 791 input_pids_dynamic, input_pids_vm, input_file_vm, & 792 input_pids_wtm, input_file_wtm, & 793 num_var_pids, & 794 pavement_pars_f, pavement_subsurface_pars_f, pavement_type_f, & 795 pids_id, & 796 root_area_density_lsm_f, soil_pars_f, & 797 soil_type_f, street_crossing_f, street_type_f, surface_fraction_f, & 798 terrain_height_f, vegetation_pars_f, vegetation_type_f, & 799 vars_pids, & 800 water_pars_f, water_type_f 789 PUBLIC albedo_pars_f, & 790 albedo_type_f, & 791 buildings_f, & 792 building_id_f, & 793 building_pars_f, & 794 building_surface_pars_f, & 795 building_type_f, & 796 char_fill, & 797 char_lod, & 798 chem_emis, & 799 chem_emis_att, & 800 chem_emis_att_type, & 801 chem_emis_val_type, & 802 coord_ref_sys, & 803 crs_list, & 804 init_3d, & 805 init_model, & 806 input_file_atts, & 807 input_file_dynamic, & 808 input_file_static, & 809 input_file_vm, & 810 input_file_wtm, & 811 input_pids_static, & 812 input_pids_dynamic, & 813 input_pids_vm, & 814 input_pids_wtm, & 815 num_var_pids, & 816 pavement_pars_f, & 817 pavement_subsurface_pars_f, & 818 pavement_type_f, & 819 pids_id, & 820 root_area_density_lsm_f, & 821 soil_pars_f, & 822 soil_type_f, & 823 street_crossing_f, & 824 street_type_f, & 825 surface_fraction_f, & 826 terrain_height_f, & 827 vars_pids, & 828 vegetation_pars_f, & 829 vegetation_type_f, & 830 water_pars_f, & 831 water_type_f 801 832 ! 802 833 !-- Public uv exposure variables 803 PUBLIC building_obstruction_f, input_file_uvem, input_pids_uvem, & 804 netcdf_data_input_uvem, & 805 uvem_integration_f, uvem_irradiance_f, & 806 uvem_projarea_f, uvem_radiance_f 834 PUBLIC building_obstruction_f, & 835 input_file_uvem, & 836 input_pids_uvem, & 837 netcdf_data_input_uvem, & 838 uvem_integration_f, & 839 uvem_irradiance_f, & 840 uvem_projarea_f, & 841 uvem_radiance_f 807 842 808 843 ! 809 844 !-- Public subroutines 810 PUBLIC netcdf_data_input_check_dynamic,&811 netcdf_data_input_check_static,&812 netcdf_data_input_chemistry_data,&813 get_dimension_length, &814 netcdf_data_input_inquire_file,&815 netcdf_data_input_init,&816 netcdf_data_input_init_3d,&817 netcdf_data_input_surface_data,&818 netcdf_data_input_topo,&819 get_attribute,&820 get_variable,&821 get_variable_pr,&822 open_read_file,&823 check_existence,&824 inquire_fill_value,&825 inquire_num_variables,&826 inquire_variable_names,&827 close_input_file845 PUBLIC check_existence, & 846 close_input_file, & 847 get_attribute, & 848 get_dimension_length, & 849 get_variable, & 850 get_variable_pr, & 851 inquire_fill_value, & 852 inquire_num_variables, & 853 inquire_variable_names, & 854 netcdf_data_input_check_dynamic, & 855 netcdf_data_input_check_static, & 856 netcdf_data_input_chemistry_data, & 857 netcdf_data_input_inquire_file, & 858 netcdf_data_input_init, & 859 netcdf_data_input_init_3d, & 860 netcdf_data_input_surface_data, & 861 netcdf_data_input_topo, & 862 open_read_file 828 863 829 864 830 865 CONTAINS 831 866 832 !------------------------------------------------------------------------------ !867 !--------------------------------------------------------------------------------------------------! 833 868 ! Description: 834 869 ! ------------ 835 !> Inquires whether NetCDF input files according to Palm-input-data standard 836 !> exist. Moreover, basicchecks are performed.837 !------------------------------------------------------------------------------ !838 839 840 USE control_parameters,&841 842 843 870 !> Inquires whether NetCDF input files according to Palm-input-data standard exist. Moreover, basic 871 !> checks are performed. 872 !--------------------------------------------------------------------------------------------------! 873 SUBROUTINE netcdf_data_input_inquire_file 874 875 USE control_parameters, & 876 ONLY: topo_no_distinct 877 878 IMPLICIT NONE 844 879 845 880 #if defined ( __netcdf ) 846 INQUIRE( FILE = TRIM( input_file_static ) // TRIM( coupling_char ),&847 848 INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ),&849 850 INQUIRE( FILE = TRIM( input_file_chem ) // TRIM( coupling_char ),&851 852 INQUIRE( FILE = TRIM( input_file_uvem ) // TRIM( coupling_char ),&853 EXIST = input_pids_uvem)854 INQUIRE( FILE = TRIM( input_file_vm ) // TRIM( coupling_char ),&855 856 INQUIRE( FILE = TRIM( input_file_wtm ) // TRIM( coupling_char ),&857 881 INQUIRE( FILE = TRIM( input_file_static ) // TRIM( coupling_char ), & 882 EXIST = input_pids_static ) 883 INQUIRE( FILE = TRIM( input_file_dynamic ) // TRIM( coupling_char ), & 884 EXIST = input_pids_dynamic ) 885 INQUIRE( FILE = TRIM( input_file_chem ) // TRIM( coupling_char ), & 886 EXIST = input_pids_chem ) 887 INQUIRE( FILE = TRIM( input_file_uvem ) // TRIM( coupling_char ), & 888 EXIST = input_pids_uvem ) 889 INQUIRE( FILE = TRIM( input_file_vm ) // TRIM( coupling_char ), & 890 EXIST = input_pids_vm ) 891 INQUIRE( FILE = TRIM( input_file_wtm ) // TRIM( coupling_char ), & 892 EXIST = input_pids_wtm ) 858 893 #endif 859 894 860 895 ! 861 !-- As long as topography can be input via ASCII format, no distinction 862 !-- between building and terrain can be made. This case, classify all 863 !-- surfaces as default type. Same in case land-surface and urban-surface 864 !-- model are not applied. 865 IF ( .NOT. input_pids_static ) THEN 866 topo_no_distinct = .TRUE. 867 ENDIF 868 869 END SUBROUTINE netcdf_data_input_inquire_file 870 871 !------------------------------------------------------------------------------! 896 !-- As long as topography can be input via ASCII format, no distinction between building and terrain 897 !-- can be done. This case, classify all surfaces as default type. Same in case land-surface and 898 !-- urban-surface model are not applied. 899 IF ( .NOT. input_pids_static ) THEN 900 topo_no_distinct = .TRUE. 901 ENDIF 902 903 END SUBROUTINE netcdf_data_input_inquire_file 904 905 !--------------------------------------------------------------------------------------------------! 872 906 ! Description: 873 907 ! ------------ 874 !> Reads global attributes and coordinate reference system required for 875 !> initialization of the model. 876 !------------------------------------------------------------------------------! 877 SUBROUTINE netcdf_data_input_init 878 879 IMPLICIT NONE 880 881 INTEGER(iwp) :: id_mod !< NetCDF id of input file 882 INTEGER(iwp) :: var_id_crs !< NetCDF id of variable crs 883 884 ! 885 !-- Define default list of crs attributes. This is required for coordinate 886 !-- transformation. 887 crs_list = (/ coord_ref_sys%semi_major_axis, & 888 coord_ref_sys%inverse_flattening, & 889 coord_ref_sys%longitude_of_prime_meridian, & 890 coord_ref_sys%longitude_of_central_meridian, & 891 coord_ref_sys%scale_factor_at_central_meridian, & 892 coord_ref_sys%latitude_of_projection_origin, & 893 coord_ref_sys%false_easting, & 894 coord_ref_sys%false_northing /) 895 896 IF ( .NOT. input_pids_static ) RETURN 908 !> Reads global attributes and coordinate reference system required for initialization of the model. 909 !--------------------------------------------------------------------------------------------------! 910 SUBROUTINE netcdf_data_input_init 911 912 IMPLICIT NONE 913 914 INTEGER(iwp) :: id_mod !< NetCDF id of input file 915 INTEGER(iwp) :: var_id_crs !< NetCDF id of variable crs 916 917 ! 918 !-- Define default list of crs attributes. This is required for coordinate transformation. 919 crs_list = (/ coord_ref_sys%semi_major_axis, & 920 coord_ref_sys%inverse_flattening, & 921 coord_ref_sys%longitude_of_prime_meridian, & 922 coord_ref_sys%longitude_of_central_meridian, & 923 coord_ref_sys%scale_factor_at_central_meridian, & 924 coord_ref_sys%latitude_of_projection_origin, & 925 coord_ref_sys%false_easting, & 926 coord_ref_sys%false_northing /) 927 928 IF ( .NOT. input_pids_static ) RETURN 897 929 898 930 #if defined ( __netcdf ) 899 931 ! 900 !-- Open file in read-only mode 901 CALL open_read_file( TRIM( input_file_static ) // & 902 TRIM( coupling_char ), id_mod ) 903 ! 904 !-- Read global attributes 905 CALL get_attribute( id_mod, input_file_atts%origin_lat_char, & 906 input_file_atts%origin_lat, .TRUE. ) 907 908 CALL get_attribute( id_mod, input_file_atts%origin_lon_char, & 909 input_file_atts%origin_lon, .TRUE. ) 910 911 CALL get_attribute( id_mod, input_file_atts%origin_time_char, & 912 input_file_atts%origin_time, .TRUE. ) 913 914 CALL get_attribute( id_mod, input_file_atts%origin_x_char, & 915 input_file_atts%origin_x, .TRUE. ) 916 917 CALL get_attribute( id_mod, input_file_atts%origin_y_char, & 918 input_file_atts%origin_y, .TRUE. ) 919 920 CALL get_attribute( id_mod, input_file_atts%origin_z_char, & 921 input_file_atts%origin_z, .TRUE. ) 922 923 CALL get_attribute( id_mod, input_file_atts%rotation_angle_char, & 924 input_file_atts%rotation_angle, .TRUE. ) 925 926 CALL get_attribute( id_mod, input_file_atts%author_char, & 927 input_file_atts%author, .TRUE., no_abort=.FALSE. ) 928 CALL get_attribute( id_mod, input_file_atts%contact_person_char, & 929 input_file_atts%contact_person, .TRUE., no_abort=.FALSE. ) 930 CALL get_attribute( id_mod, input_file_atts%institution_char, & 931 input_file_atts%institution, .TRUE., no_abort=.FALSE. ) 932 CALL get_attribute( id_mod, input_file_atts%acronym_char, & 933 input_file_atts%acronym, .TRUE., no_abort=.FALSE. ) 934 935 CALL get_attribute( id_mod, input_file_atts%campaign_char, & 936 input_file_atts%campaign, .TRUE., no_abort=.FALSE. ) 937 CALL get_attribute( id_mod, input_file_atts%location_char, & 938 input_file_atts%location, .TRUE., no_abort=.FALSE. ) 939 CALL get_attribute( id_mod, input_file_atts%site_char, & 940 input_file_atts%site, .TRUE., no_abort=.FALSE. ) 941 942 CALL get_attribute( id_mod, input_file_atts%source_char, & 943 input_file_atts%source, .TRUE., no_abort=.FALSE. ) 944 CALL get_attribute( id_mod, input_file_atts%references_char, & 945 input_file_atts%references, .TRUE., no_abort=.FALSE. ) 946 CALL get_attribute( id_mod, input_file_atts%keywords_char, & 947 input_file_atts%keywords, .TRUE., no_abort=.FALSE. ) 948 CALL get_attribute( id_mod, input_file_atts%licence_char, & 949 input_file_atts%licence, .TRUE., no_abort=.FALSE. ) 950 CALL get_attribute( id_mod, input_file_atts%comment_char, & 951 input_file_atts%comment, .TRUE., no_abort=.FALSE. ) 952 ! 953 !-- Read coordinate reference system if available 954 nc_stat = NF90_INQ_VARID( id_mod, 'crs', var_id_crs ) 955 IF ( nc_stat == NF90_NOERR ) THEN 956 CALL get_attribute( id_mod, 'epsg_code', & 957 coord_ref_sys%epsg_code, & 958 .FALSE., 'crs' ) 959 CALL get_attribute( id_mod, 'false_easting', & 960 coord_ref_sys%false_easting, & 961 .FALSE., 'crs' ) 962 CALL get_attribute( id_mod, 'false_northing', & 963 coord_ref_sys%false_northing, & 964 .FALSE., 'crs' ) 965 CALL get_attribute( id_mod, 'grid_mapping_name', & 966 coord_ref_sys%grid_mapping_name, & 967 .FALSE., 'crs' ) 968 CALL get_attribute( id_mod, 'inverse_flattening', & 969 coord_ref_sys%inverse_flattening, & 970 .FALSE., 'crs' ) 971 CALL get_attribute( id_mod, 'latitude_of_projection_origin', & 972 coord_ref_sys%latitude_of_projection_origin, & 973 .FALSE., 'crs' ) 974 CALL get_attribute( id_mod, 'long_name', & 975 coord_ref_sys%long_name, & 976 .FALSE., 'crs' ) 977 CALL get_attribute( id_mod, 'longitude_of_central_meridian', & 978 coord_ref_sys%longitude_of_central_meridian, & 979 .FALSE., 'crs' ) 980 CALL get_attribute( id_mod, 'longitude_of_prime_meridian', & 981 coord_ref_sys%longitude_of_prime_meridian, & 982 .FALSE., 'crs' ) 983 CALL get_attribute( id_mod, 'scale_factor_at_central_meridian', & 984 coord_ref_sys%scale_factor_at_central_meridian, & 985 .FALSE., 'crs' ) 986 CALL get_attribute( id_mod, 'semi_major_axis', & 987 coord_ref_sys%semi_major_axis, & 988 .FALSE., 'crs' ) 989 CALL get_attribute( id_mod, 'units', & 990 coord_ref_sys%units, & 991 .FALSE., 'crs' ) 992 ELSE 993 ! 994 !-- Calculate central meridian from origin_lon 995 coord_ref_sys%longitude_of_central_meridian = & 996 CEILING( input_file_atts%origin_lon / 6.0_wp ) * 6.0_wp - 3.0_wp 997 ENDIF 998 ! 999 !-- Finally, close input file 1000 CALL close_input_file( id_mod ) 932 !-- Open file in read-only mode 933 CALL open_read_file( TRIM( input_file_static ) // TRIM( coupling_char ), id_mod ) 934 ! 935 !-- Read global attributes 936 CALL get_attribute( id_mod, input_file_atts%origin_lat_char, & 937 input_file_atts%origin_lat, .TRUE. ) 938 939 CALL get_attribute( id_mod, input_file_atts%origin_lon_char, & 940 input_file_atts%origin_lon, .TRUE. ) 941 942 CALL get_attribute( id_mod, input_file_atts%origin_time_char, & 943 input_file_atts%origin_time, .TRUE. ) 944 945 CALL get_attribute( id_mod, input_file_atts%origin_x_char, & 946 input_file_atts%origin_x, .TRUE. ) 947 948 CALL get_attribute( id_mod, input_file_atts%origin_y_char, & 949 input_file_atts%origin_y, .TRUE. ) 950 951 CALL get_attribute( id_mod, input_file_atts%origin_z_char, & 952 input_file_atts%origin_z, .TRUE. ) 953 954 CALL get_attribute( id_mod, input_file_atts%rotation_angle_char, & 955 input_file_atts%rotation_angle, .TRUE. ) 956 957 CALL get_attribute( id_mod, input_file_atts%author_char, & 958 input_file_atts%author, .TRUE., no_abort=.FALSE. ) 959 960 CALL get_attribute( id_mod, input_file_atts%contact_person_char, & 961 input_file_atts%contact_person, .TRUE., no_abort=.FALSE. ) 962 CALL get_attribute( id_mod, input_file_atts%institution_char, & 963 input_file_atts%institution, .TRUE., no_abort=.FALSE. ) 964 CALL get_attribute( id_mod, input_file_atts%acronym_char, & 965 input_file_atts%acronym, .TRUE., no_abort=.FALSE. ) 966 967 CALL get_attribute( id_mod, input_file_atts%campaign_char, & 968 input_file_atts%campaign, .TRUE., no_abort=.FALSE. ) 969 CALL get_attribute( id_mod, input_file_atts%location_char, & 970 input_file_atts%location, .TRUE., no_abort=.FALSE. ) 971 CALL get_attribute( id_mod, input_file_atts%site_char, & 972 input_file_atts%site, .TRUE., no_abort=.FALSE. ) 973 974 CALL get_attribute( id_mod, input_file_atts%source_char, & 975 input_file_atts%source, .TRUE., no_abort=.FALSE. ) 976 CALL get_attribute( id_mod, input_file_atts%references_char, & 977 input_file_atts%references, .TRUE., no_abort=.FALSE. ) 978 CALL get_attribute( id_mod, input_file_atts%keywords_char, & 979 input_file_atts%keywords, .TRUE., no_abort=.FALSE. ) 980 CALL get_attribute( id_mod, input_file_atts%licence_char, & 981 input_file_atts%licence, .TRUE., no_abort=.FALSE. ) 982 CALL get_attribute( id_mod, input_file_atts%comment_char, & 983 input_file_atts%comment, .TRUE., no_abort=.FALSE. ) 984 ! 985 !-- Read coordinate reference system if available 986 nc_stat = NF90_INQ_VARID( id_mod, 'crs', var_id_crs ) 987 IF ( nc_stat == NF90_NOERR ) THEN 988 CALL get_attribute( id_mod, 'epsg_code', coord_ref_sys%epsg_code, .FALSE., 'crs' ) 989 CALL get_attribute( id_mod, 'false_easting', coord_ref_sys%false_easting, .FALSE., 'crs' ) 990 CALL get_attribute( id_mod, 'false_northing', coord_ref_sys%false_northing, .FALSE., 'crs' ) 991 CALL get_attribute( id_mod, 'grid_mapping_name', coord_ref_sys%grid_mapping_name, .FALSE., & 992 'crs' ) 993 CALL get_attribute( id_mod, 'inverse_flattening', coord_ref_sys%inverse_flattening, .FALSE.,& 994 'crs' ) 995 CALL get_attribute( id_mod, 'latitude_of_projection_origin', & 996 coord_ref_sys%latitude_of_projection_origin, .FALSE., 'crs' ) 997 CALL get_attribute( id_mod, 'long_name', coord_ref_sys%long_name, .FALSE., 'crs' ) 998 CALL get_attribute( id_mod, 'longitude_of_central_meridian', & 999 coord_ref_sys%longitude_of_central_meridian, .FALSE., 'crs' ) 1000 CALL get_attribute( id_mod, 'longitude_of_prime_meridian', & 1001 coord_ref_sys%longitude_of_prime_meridian, .FALSE., 'crs' ) 1002 CALL get_attribute( id_mod, 'scale_factor_at_central_meridian', & 1003 coord_ref_sys%scale_factor_at_central_meridian, .FALSE., 'crs' ) 1004 CALL get_attribute( id_mod, 'semi_major_axis', coord_ref_sys%semi_major_axis, .FALSE., 'crs') 1005 CALL get_attribute( id_mod, 'units', coord_ref_sys%units, .FALSE., 'crs' ) 1006 ELSE 1007 ! 1008 !-- Calculate central meridian from origin_lon 1009 coord_ref_sys%longitude_of_central_meridian = & 1010 CEILING( input_file_atts%origin_lon / 6.0_wp ) * 6.0_wp - 3.0_wp 1011 ENDIF 1012 ! 1013 !-- Finally, close input file 1014 CALL close_input_file( id_mod ) 1001 1015 #endif 1002 1016 ! 1003 !-- Copy latitude, longitude, origin_z, rotation angle on init type 1004 !-- NOTE: A shifting height might have already been saved to orgin_z in 1005 !-- init_grid; therefore, do not override but add the reference height from 1006 !-- the input file. 1007 init_model%latitude = input_file_atts%origin_lat 1008 init_model%longitude = input_file_atts%origin_lon 1009 init_model%origin_time = input_file_atts%origin_time 1010 init_model%origin_x = input_file_atts%origin_x 1011 init_model%origin_y = input_file_atts%origin_y 1012 init_model%origin_z = init_model%origin_z + input_file_atts%origin_z 1013 init_model%rotation_angle = input_file_atts%rotation_angle 1014 1015 ! 1016 !-- Update list of crs attributes. This is required for coordinate 1017 !-- transformation. 1018 crs_list = (/ coord_ref_sys%semi_major_axis, & 1019 coord_ref_sys%inverse_flattening, & 1020 coord_ref_sys%longitude_of_prime_meridian, & 1021 coord_ref_sys%longitude_of_central_meridian, & 1022 coord_ref_sys%scale_factor_at_central_meridian, & 1023 coord_ref_sys%latitude_of_projection_origin, & 1024 coord_ref_sys%false_easting, & 1025 coord_ref_sys%false_northing /) 1026 ! 1027 !-- In case of nested runs, each model domain might have different longitude 1028 !-- and latitude, which would result in different Coriolis parameters and 1029 !-- sun-zenith angles. To avoid this, longitude and latitude in each model 1030 !-- domain will be set to the values of the root model. Please note, this 1031 !-- synchronization is required already here. 1017 !-- Copy latitude, longitude, origin_z, rotation angle on init type. 1018 !-- Note: A shifting height might have already been saved to orgin_z in init_grid; therefore, do not 1019 !-- override but add the reference height from the input file. 1020 init_model%latitude = input_file_atts%origin_lat 1021 init_model%longitude = input_file_atts%origin_lon 1022 init_model%origin_time = input_file_atts%origin_time 1023 init_model%origin_x = input_file_atts%origin_x 1024 init_model%origin_y = input_file_atts%origin_y 1025 init_model%origin_z = init_model%origin_z + input_file_atts%origin_z 1026 init_model%rotation_angle = input_file_atts%rotation_angle 1027 1028 ! 1029 !-- Update list of crs attributes. This is required for coordinate transformation. 1030 crs_list = (/ coord_ref_sys%semi_major_axis, & 1031 coord_ref_sys%inverse_flattening, & 1032 coord_ref_sys%longitude_of_prime_meridian, & 1033 coord_ref_sys%longitude_of_central_meridian, & 1034 coord_ref_sys%scale_factor_at_central_meridian, & 1035 coord_ref_sys%latitude_of_projection_origin, & 1036 coord_ref_sys%false_easting, & 1037 coord_ref_sys%false_northing /) 1038 ! 1039 !-- In case of nested runs, each model domain might have different longitude and latitude, which 1040 !-- would result in different Coriolis parameters and sun-zenith angles. To avoid this, longitude 1041 !-- and latitude in each model domain will be set to the values of the root model. Please note, this 1042 !-- synchronization is required already here. 1032 1043 #if defined( __parallel ) 1033 CALL MPI_BCAST( init_model%latitude, 1, MPI_REAL, 0, & 1034 MPI_COMM_WORLD, ierr ) 1035 CALL MPI_BCAST( init_model%longitude, 1, MPI_REAL, 0, & 1036 MPI_COMM_WORLD, ierr ) 1044 CALL MPI_BCAST( init_model%latitude, 1, MPI_REAL, 0, MPI_COMM_WORLD, ierr ) 1045 CALL MPI_BCAST( init_model%longitude, 1, MPI_REAL, 0, MPI_COMM_WORLD, ierr ) 1037 1046 #endif 1038 1047 1039 1040 1041 1042 !------------------------------------------------------------------------------ !1048 END SUBROUTINE netcdf_data_input_init 1049 1050 1051 !--------------------------------------------------------------------------------------------------! 1043 1052 ! Description: 1044 1053 ! ------------ 1045 1054 !> Reads Chemistry NETCDF Input data, such as emission values, emission species, etc. 1046 !------------------------------------------------------------------------------! 1047 1048 SUBROUTINE netcdf_data_input_chemistry_data(emt_att,emt) 1049 1050 USE chem_modules, & 1051 ONLY: emiss_lod, time_fac_type, surface_csflux_name 1052 1053 USE control_parameters, & 1054 ONLY: message_string 1055 1056 USE indices, & 1057 ONLY: nxl, nxr, nys, nyn 1058 1059 IMPLICIT NONE 1060 1061 TYPE(chem_emis_att_type), INTENT(INOUT) :: emt_att 1062 TYPE(chem_emis_val_type), ALLOCATABLE, DIMENSION(:), INTENT(INOUT) :: emt 1063 1064 INTEGER(iwp) :: i, j, k !< generic counters 1065 INTEGER(iwp) :: ispec !< index for number of emission species in input 1066 INTEGER(iwp) :: len_dims !< Length of dimension 1067 INTEGER(iwp) :: num_vars !< number of variables in netcdf input file 1055 !--------------------------------------------------------------------------------------------------! 1056 SUBROUTINE netcdf_data_input_chemistry_data( emt_att, emt ) 1057 1058 USE chem_modules, & 1059 ONLY: emiss_lod, surface_csflux_name, time_fac_type 1060 1061 USE control_parameters, & 1062 ONLY: message_string 1063 1064 USE indices, & 1065 ONLY: nxl, nxr, nys, nyn 1066 1067 IMPLICIT NONE 1068 1069 TYPE(chem_emis_att_type), INTENT(INOUT) :: emt_att 1070 TYPE(chem_emis_val_type), ALLOCATABLE, DIMENSION(:), INTENT(INOUT) :: emt 1071 1072 INTEGER(iwp) :: i, j, k !< generic counters 1073 INTEGER(iwp) :: ispec !< index for number of emission species in input 1074 INTEGER(iwp) :: len_dims !< Length of dimension 1075 INTEGER(iwp) :: num_vars !< number of variables in netcdf input file 1068 1076 1069 1077 ! 1070 1078 !-- dum_var_4d are designed to read in emission_values from the chemistry netCDF file. 1071 !-- Currently the vestigial "z" dimension in emission_values makes it a 5D array, 1072 !-- hence the corresponding dum_var_5d array. When the "z" dimension is removed 1073 !-- completely, dum_var_4d will be used instead 1074 !-- (ecc 20190425) 1075 1076 ! REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: dum_var_4d !< temp array 4 4D chem emission data 1077 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:,:) :: dum_var_5d !< temp array 4 5D chem emission data 1079 !-- Currently the vestigial "z" dimension in emission_values makes it a 5D array, hence the 1080 !-- corresponding dum_var_5d array. When the "z" dimension is removed completely, dum_var_4d will be 1081 !-- used instead (ecc 20190425) 1082 1083 ! REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: dum_var_4d !< temp array 4 4D chem emission data 1084 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:,:) :: dum_var_5d !< temp array 4 5D chem emission data 1078 1085 1079 1086 ! … … 1081 1088 ! 1082 1089 !-- Emission LOD 0 (Parameterized mode) 1083 1084 IF ( emiss_lod == 0 ) THEN 1085 1086 ! for reference (ecc) 1087 ! IF (TRIM(mode_emis) == "PARAMETERIZED" .OR. TRIM(mode_emis) == "parameterized") THEN 1088 1089 ispec=1 1090 emt_att%n_emiss_species = 0 1091 1092 ! 1093 !-- number of species 1094 1095 DO WHILE (TRIM( surface_csflux_name( ispec ) ) /= 'novalue' ) 1096 1097 emt_att%n_emiss_species = emt_att%n_emiss_species + 1 1098 ispec=ispec+1 1099 ! 1100 !-- followling line retained for compatibility with salsa_mod 1101 !-- which still uses emt_att%nspec heavily (ecc) 1102 1103 emt_att%nspec = emt_att%nspec + 1 1104 1105 ENDDO 1106 1107 ! 1108 !-- allocate emission values data type arrays 1109 1110 ALLOCATE ( emt(emt_att%n_emiss_species) ) 1111 1112 ! 1113 !-- Read EMISSION SPECIES NAMES 1114 1115 ! 1116 !-- allocate space for strings 1117 1118 ALLOCATE (emt_att%species_name(emt_att%n_emiss_species) ) 1119 1120 DO ispec = 1, emt_att%n_emiss_species 1121 emt_att%species_name(ispec) = TRIM(surface_csflux_name(ispec)) 1122 ENDDO 1090 IF ( emiss_lod == 0 ) THEN 1091 1092 ! 1093 !-- For reference (ecc) 1094 ! IF (TRIM(mode_emis) == "PARAMETERIZED" .OR. TRIM(mode_emis) == "parameterized") THEN 1095 1096 ispec=1 1097 emt_att%n_emiss_species = 0 1098 1099 ! 1100 !-- Number of species 1101 DO WHILE ( TRIM( surface_csflux_name( ispec ) ) /= 'novalue' ) 1102 1103 emt_att%n_emiss_species = emt_att%n_emiss_species + 1 1104 ispec = ispec + 1 1105 ! 1106 !-- Followling line retained for compatibility with salsa_mod which still uses emt_att%nspec 1107 !-- heavily (ecc) 1108 emt_att%nspec = emt_att%nspec + 1 1109 1110 ENDDO 1111 1112 ! 1113 !-- Allocate emission values data type arrays 1114 ALLOCATE( emt(emt_att%n_emiss_species) ) 1115 1116 ! 1117 !-- Read emission species names 1118 1119 ! 1120 !-- Allocate space for strings 1121 ALLOCATE( emt_att%species_name(emt_att%n_emiss_species) ) 1122 1123 DO ispec = 1, emt_att%n_emiss_species 1124 emt_att%species_name(ispec) = TRIM( surface_csflux_name(ispec) ) 1125 ENDDO 1123 1126 1124 1127 ! 1125 1128 !-- LOD 1 (default mode) and LOD 2 (pre-processed mode) 1126 1127 ELSE 1129 ELSE 1128 1130 1129 1131 #if defined ( __netcdf ) 1130 1132 1131 IF ( .NOT. input_pids_chem ) RETURN 1132 1133 ! 1134 !-- first we allocate memory space for the emission species and then 1135 !-- we differentiate between LOD 1 (default mode) and LOD 2 (pre-processed mode) 1136 1137 ! 1138 !-- open emission data file ( {palmcase}_chemistry ) 1139 1140 CALL open_read_file ( TRIM(input_file_chem) // TRIM(coupling_char), id_emis ) 1141 1142 ! 1143 !-- inquire number of variables 1144 1145 CALL inquire_num_variables ( id_emis, num_vars ) 1146 1147 ! 1148 !-- Get General Dimension Lengths: only # species and # categories. 1149 !-- Tther dimensions depend on the emission mode or specific components 1150 1151 CALL get_dimension_length ( id_emis, emt_att%n_emiss_species, 'nspecies' ) 1152 1153 ! 1154 !-- backward compatibility for salsa_mod (ecc) 1155 1156 emt_att%nspec = emt_att%n_emiss_species 1157 1158 ! 1159 !-- Allocate emission values data type arrays 1160 1161 ALLOCATE ( emt(emt_att%n_emiss_species) ) 1162 1163 ! 1164 !-- READING IN SPECIES NAMES 1165 1166 ! 1167 !-- Allocate memory for species names 1168 1169 ALLOCATE ( emt_att%species_name(emt_att%n_emiss_species) ) 1170 1171 ! 1172 !-- Retrieve variable name (again, should use n_emiss_strlen) 1173 1174 CALL get_variable( id_emis, 'emission_name', & 1175 string_values, emt_att%n_emiss_species ) 1176 emt_att%species_name=string_values 1177 1178 ! 1179 !-- dealocate string_values previously allocated in get_variable call 1180 1181 IF ( ALLOCATED(string_values) ) DEALLOCATE (string_values) 1182 1183 ! 1184 !-- READING IN SPECIES INDICES 1185 1186 ! 1187 !-- Allocate memory for species indices 1188 1189 ALLOCATE ( emt_att%species_index(emt_att%n_emiss_species) ) 1190 1191 ! 1192 !-- Retrieve variable data 1193 1194 CALL get_variable( id_emis, 'emission_index', emt_att%species_index ) 1195 ! 1196 !-- Now the routine has to distinguish between chemistry emission 1197 !-- LOD 1 (DEFAULT mode) and LOD 2 (PRE-PROCESSED mode) 1198 1199 ! 1200 !-- START OF EMISSION LOD 1 (DEFAULT MODE) 1201 1202 1203 IF ( emiss_lod == 1 ) THEN 1204 1205 ! for reference (ecc) 1133 IF ( .NOT. input_pids_chem ) RETURN 1134 1135 ! 1136 !-- First we allocate memory space for the emission species and then we differentiate between 1137 !-- LOD 1 (default mode) and LOD 2 (pre-processed mode) 1138 1139 ! 1140 !-- Open emission data file ( {palmcase}_chemistry ) 1141 CALL open_read_file( TRIM( input_file_chem ) // TRIM( coupling_char ), id_emis ) 1142 1143 ! 1144 !-- Inquire number of variables 1145 CALL inquire_num_variables( id_emis, num_vars ) 1146 1147 ! 1148 !-- Get general dimension lengths: only # species and # categories. 1149 !-- Other dimensions depend on the emission mode or specific components. 1150 CALL get_dimension_length( id_emis, emt_att%n_emiss_species, 'nspecies' ) 1151 1152 ! 1153 !-- Backward compatibility for salsa_mod (ecc) 1154 emt_att%nspec = emt_att%n_emiss_species 1155 1156 ! 1157 !-- Allocate emission values data type arrays 1158 ALLOCATE( emt(emt_att%n_emiss_species) ) 1159 1160 ! 1161 !-- Reading in species names 1162 1163 ! 1164 !-- Allocate memory for species names 1165 ALLOCATE( emt_att%species_name(emt_att%n_emiss_species) ) 1166 1167 ! 1168 !-- Retrieve variable name (again, should use n_emiss_strlen) 1169 CALL get_variable( id_emis, 'emission_name', string_values, emt_att%n_emiss_species ) 1170 emt_att%species_name=string_values 1171 1172 ! 1173 !-- Dealocate string_values previously allocated in get_variable call 1174 IF ( ALLOCATED( string_values ) ) DEALLOCATE( string_values ) 1175 1176 ! 1177 !-- Reading in species indices 1178 1179 ! 1180 !-- Allocate memory for species indices 1181 ALLOCATE( emt_att%species_index(emt_att%n_emiss_species) ) 1182 1183 ! 1184 !-- Retrieve variable data 1185 CALL get_variable( id_emis, 'emission_index', emt_att%species_index ) 1186 ! 1187 !-- Now the routine has to distinguish between chemistry emission LOD 1 (default mode) and LOD 2 1188 !-- (pre-processed mode) 1189 1190 ! 1191 !-- Start of emission LOD 1 (default mode) 1192 IF ( emiss_lod == 1 ) THEN 1193 ! 1194 !-- For reference (ecc) 1206 1195 ! IF (TRIM(mode_emis) == "DEFAULT" .OR. TRIM(mode_emis) == "default") THEN 1207 1196 1208 ! 1209 !-- get number of emission categories 1210 1211 CALL get_dimension_length ( id_emis, emt_att%ncat, 'ncat' ) 1212 1213 !-- READING IN EMISSION CATEGORIES INDICES 1214 1215 ALLOCATE ( emt_att%cat_index(emt_att%ncat) ) 1216 1217 ! 1218 !-- Retrieve variable data 1219 1220 CALL get_variable( id_emis, 'emission_cat_index', emt_att%cat_index ) 1221 1222 1223 ! 1224 !-- Loop through individual species to get basic information on 1225 !-- VOC/PM/NOX/SOX 1226 1227 !------------------------------------------------------------------------------ 1228 !-- NOTE - CHECK ARRAY INDICES FOR READING IN NAMES AND SPECIES 1229 !-- IN LOD1 (DEFAULT MODE) FOR THE VARIOUS MODE SPLITS 1230 !-- AS ALL ID_EMIS CONDITIONALS HAVE BEEN REMOVED FROM GET_VAR 1231 !-- FUNCTIONS. IN THEORY THIS WOULD MEAN ALL ARRAYS SHOULD BE 1232 !-- READ FROM 0 to N-1 (C CONVENTION) AS OPPOSED TO 1 to N 1233 !-- (FORTRAN CONVENTION). KEEP THIS IN MIND !! 1197 ! 1198 !-- Get number of emission categories 1199 CALL get_dimension_length( id_emis, emt_att%ncat, 'ncat' ) 1200 1201 !-- Reading in emission categories indices 1202 ALLOCATE( emt_att%cat_index(emt_att%ncat) ) 1203 1204 ! 1205 !-- Retrieve variable data 1206 CALL get_variable( id_emis, 'emission_cat_index', emt_att%cat_index ) 1207 1208 1209 ! 1210 !-- Loop through individual species to get basic information on VOC/PM/NOX/SOX 1211 1212 !--------------------------------------------------------------------------------------------------- 1213 !-- Note - Check array indices for reading in names and species in LOD1 (default mode) for the 1214 !-- various mode splits as all id_emis conditionals have been removed from get_var_functions. 1215 !-- In theory this would mean all arrays should be read from 0 to n-1 (C convention) as 1216 !-- opposed to 1 to n (FORTRAN convention). Keep this in mind !! 1234 1217 !-- (ecc 20190424) 1235 !------------------------------------------------------------------------------ 1236 1237 DO ispec = 1, emt_att%n_emiss_species 1238 1239 ! 1240 !-- VOC DATA (name and composition) 1241 1242 IF ( TRIM(emt_att%species_name(ispec)) == "VOC" .OR. & 1243 TRIM(emt_att%species_name(ispec)) == "voc" ) THEN 1244 1245 ! 1246 !-- VOC name 1247 CALL get_dimension_length ( id_emis, emt_att%nvoc, 'nvoc' ) 1248 ALLOCATE ( emt_att%voc_name(emt_att%nvoc) ) 1249 CALL get_variable ( id_emis,"emission_voc_name", & 1250 string_values, emt_att%nvoc ) 1251 emt_att%voc_name = string_values 1252 IF ( ALLOCATED(string_values) ) DEALLOCATE (string_values) 1253 1254 ! 1255 !-- VOC composition 1256 1257 ALLOCATE ( emt_att%voc_comp(emt_att%ncat,emt_att%nvoc) ) 1258 CALL get_variable ( id_emis, "composition_voc", emt_att%voc_comp, & 1259 1, emt_att%ncat, 1, emt_att%nvoc ) 1260 1261 ENDIF ! VOC 1262 1263 ! 1264 !-- PM DATA (name and composition) 1265 1266 IF ( TRIM(emt_att%species_name(ispec)) == "PM" .OR. & 1267 TRIM(emt_att%species_name(ispec)) == "pm") THEN 1268 1269 ! 1270 !-- PM name 1271 1272 CALL get_dimension_length ( id_emis, emt_att%npm, 'npm' ) 1273 ALLOCATE ( emt_att%pm_name(emt_att%npm) ) 1274 CALL get_variable ( id_emis, "pm_name", string_values, emt_att%npm ) 1275 emt_att%pm_name = string_values 1276 IF ( ALLOCATED(string_values) ) DEALLOCATE (string_values) 1277 1278 ! 1279 !-- PM composition (PM1, PM2.5 and PM10) 1280 1281 len_dims = 3 ! PM1, PM2.5, PM10 1282 ALLOCATE(emt_att%pm_comp(emt_att%ncat,emt_att%npm,len_dims)) 1283 CALL get_variable ( id_emis, "composition_pm", emt_att%pm_comp, & 1284 1, emt_att%ncat, 1, emt_att%npm, 1, len_dims ) 1285 1286 ENDIF ! PM 1287 1288 ! 1289 !-- NOX (NO and NO2) 1290 1291 IF ( TRIM(emt_att%species_name(ispec)) == "NOX" .OR. & 1292 TRIM(emt_att%species_name(ispec)) == "nox" ) THEN 1293 1294 ALLOCATE ( emt_att%nox_comp(emt_att%ncat,emt_att%nnox) ) 1295 CALL get_variable ( id_emis, "composition_nox", emt_att%nox_comp, & 1296 1, emt_att%ncat, 1, emt_att%nnox ) 1297 1298 ENDIF ! NOX 1299 1300 ! 1301 !-- SOX (SO2 and SO4) 1302 1303 IF ( TRIM(emt_att%species_name(ispec)) == "SOX" .OR. & 1304 TRIM(emt_att%species_name(ispec)) == "sox" ) THEN 1305 1306 ALLOCATE ( emt_att%sox_comp(emt_att%ncat,emt_att%nsox) ) 1307 CALL get_variable ( id_emis, "composition_sox", emt_att%sox_comp, & 1308 1, emt_att%ncat, 1, emt_att%nsox ) 1309 1310 ENDIF ! SOX 1311 1312 ENDDO ! do ispec 1313 1314 ! 1315 !-- EMISSION TIME SCALING FACTORS (hourly and MDH data) 1316 1317 ! 1318 !-- HOUR 1319 IF ( TRIM(time_fac_type) == "HOUR" .OR. & 1320 TRIM(time_fac_type) == "hour" ) THEN 1321 1322 CALL get_dimension_length ( id_emis, emt_att%nhoursyear, 'nhoursyear' ) 1323 ALLOCATE ( emt_att%hourly_emis_time_factor(emt_att%ncat,emt_att%nhoursyear) ) 1324 CALL get_variable ( id_emis, "emission_time_factors", & 1325 emt_att%hourly_emis_time_factor, & 1326 1, emt_att%ncat, 1, emt_att%nhoursyear ) 1327 1328 ! 1329 !-- MDH 1330 1331 ELSE IF ( TRIM(time_fac_type) == "MDH" .OR. & 1332 TRIM(time_fac_type) == "mdh" ) THEN 1333 1334 CALL get_dimension_length ( id_emis, emt_att%nmonthdayhour, 'nmonthdayhour' ) 1335 ALLOCATE ( emt_att%mdh_emis_time_factor(emt_att%ncat,emt_att%nmonthdayhour) ) 1336 CALL get_variable ( id_emis, "emission_time_factors", & 1337 emt_att%mdh_emis_time_factor, & 1338 1, emt_att%ncat, 1, emt_att%nmonthdayhour ) 1339 1340 ! 1341 !-- ERROR (time factor undefined) 1342 1343 ELSE 1344 1345 message_string = 'We are in the DEFAULT chemistry emissions mode: ' // & 1346 ' !no time-factor type specified!' // & 1347 'Please specify the value of time_fac_type:' // & 1348 ' either "MDH" or "HOUR"' 1349 CALL message( 'netcdf_data_input_chemistry_data', 'CM0200', 2, 2, 0, 6, 0 ) 1350 1351 1352 ENDIF ! time_fac_type 1353 1354 ! 1355 !-- read in default (LOD1) emissions from chemisty netCDF file per species 1356 1357 ! 1358 !-- NOTE - at the moment the data is read in per species, but in the future it would 1359 !-- be much more sensible to read in per species per time step to reduce 1360 !-- memory consumption and, to a lesser degree, dimensionality of data exchange 1361 !-- (I expect this will be necessary when the problem size is large) 1362 1363 DO ispec = 1, emt_att%n_emiss_species 1364 1365 ! 1366 !-- allocate space for species specific emission values 1367 !-- NOTE - this array is extended by 1 cell in each horizontal direction 1368 !-- to compensate for an apparent linear offset. The reason of this 1369 !-- offset is not known but it has been determined to take place beyond the 1370 !-- scope of this module, and has little to do with index conventions. 1371 !-- That is, setting the array horizontal limit from nx0:nx1 to 1:(nx1-nx0+1) 1372 !-- or nx0+1:nx1+1 did not result in correct or definite behavior 1373 !-- This must be looked at at some point by the Hannover team but for now 1374 !-- this workaround is deemed reasonable (ecc 20190417) 1375 1376 IF ( .NOT. ALLOCATED ( emt(ispec)%default_emission_data ) ) THEN 1377 ALLOCATE ( emt(ispec)%default_emission_data(emt_att%ncat,nys:nyn+1,nxl:nxr+1) ) 1378 ENDIF 1379 ! 1380 !-- allocate dummy variable w/ index order identical to that shown in the netCDF header 1381 1382 ALLOCATE ( dum_var_5d(1,nys:nyn,nxl:nxr,1,emt_att%ncat) ) 1383 ! 1384 !-- get variable. be very careful 1385 !-- I am using get_variable_5d_real_dynamic (note logical argument at the end) 1386 !-- 1) use Fortran index convention (i.e., 1 to N) 1387 !-- 2) index order must be in reverse order from above allocation order 1388 1389 CALL get_variable ( id_emis, "emission_values", dum_var_5d, & 1390 1, ispec, nxl+1, nys+1, 1, & 1391 emt_att%ncat, 1, nxr-nxl+1, nyn-nys+1, emt_att%dt_emission, & 1392 .FALSE. ) 1393 ! 1394 !-- assign temp array to data structure then deallocate temp array 1395 !-- NOTE - indices are shifted from nx0:nx1 to nx0+1:nx1+1 to offset 1396 !-- the emission data array to counter said domain offset 1397 !-- (ecc 20190417) 1398 1399 DO k = 1, emt_att%ncat 1400 DO j = nys+1, nyn+1 1401 DO i = nxl+1, nxr+1 1402 emt(ispec)%default_emission_data(k,j,i) = dum_var_5d(1,j-1,i-1,1,k) 1403 ENDDO 1218 !-------------------------------------------------------------------------------------------------- 1219 1220 DO ispec = 1, emt_att%n_emiss_species 1221 1222 ! 1223 !-- VOC data (name and composition) 1224 IF ( TRIM( emt_att%species_name(ispec) ) == "VOC" .OR. & 1225 TRIM( emt_att%species_name(ispec) ) == "voc" ) THEN 1226 1227 ! 1228 !-- VOC name 1229 CALL get_dimension_length( id_emis, emt_att%nvoc, 'nvoc' ) 1230 ALLOCATE( emt_att%voc_name(emt_att%nvoc) ) 1231 CALL get_variable ( id_emis,"emission_voc_name", string_values, emt_att%nvoc ) 1232 emt_att%voc_name = string_values 1233 IF ( ALLOCATED( string_values ) ) DEALLOCATE( string_values ) 1234 1235 ! 1236 !-- VOC composition 1237 ALLOCATE( emt_att%voc_comp(emt_att%ncat,emt_att%nvoc) ) 1238 CALL get_variable( id_emis, "composition_voc", emt_att%voc_comp, 1, emt_att%ncat, & 1239 1, emt_att%nvoc ) 1240 1241 ENDIF ! VOC 1242 1243 ! 1244 !-- PM data (name and composition) 1245 IF ( TRIM( emt_att%species_name(ispec) ) == "PM" .OR. & 1246 TRIM( emt_att%species_name(ispec) ) == "pm") THEN 1247 1248 ! 1249 !-- PM name 1250 CALL get_dimension_length( id_emis, emt_att%npm, 'npm' ) 1251 ALLOCATE( emt_att%pm_name(emt_att%npm) ) 1252 CALL get_variable ( id_emis, "pm_name", string_values, emt_att%npm ) 1253 emt_att%pm_name = string_values 1254 IF ( ALLOCATED( string_values ) ) DEALLOCATE( string_values ) 1255 1256 ! 1257 !-- PM composition (PM1, PM2.5 and PM10) 1258 len_dims = 3 ! PM1, PM2.5, PM10 1259 ALLOCATE( emt_att%pm_comp(emt_att%ncat,emt_att%npm,len_dims) ) 1260 CALL get_variable( id_emis, "composition_pm", emt_att%pm_comp, 1, emt_att%ncat, 1, & 1261 emt_att%npm, 1, len_dims ) 1262 1263 ENDIF ! PM 1264 1265 ! 1266 !-- NOX (NO and NO2) 1267 IF ( TRIM( emt_att%species_name(ispec) ) == "NOX" .OR. & 1268 TRIM( emt_att%species_name(ispec) ) == "nox" ) THEN 1269 1270 ALLOCATE( emt_att%nox_comp(emt_att%ncat,emt_att%nnox) ) 1271 CALL get_variable( id_emis, "composition_nox", emt_att%nox_comp, 1, emt_att%ncat, & 1272 1, emt_att%nnox ) 1273 1274 ENDIF ! NOX 1275 1276 ! 1277 !-- SOX (SO2 and SO4) 1278 IF ( TRIM( emt_att%species_name(ispec) ) == "SOX" .OR. & 1279 TRIM( emt_att%species_name(ispec) ) == "sox" ) THEN 1280 1281 ALLOCATE( emt_att%sox_comp(emt_att%ncat,emt_att%nsox) ) 1282 CALL get_variable( id_emis, "composition_sox", emt_att%sox_comp, 1, emt_att%ncat, & 1283 1, emt_att%nsox ) 1284 1285 ENDIF ! SOX 1286 1287 ENDDO ! do ispec 1288 1289 ! 1290 !-- Emission time scaling factors (hourly and MDH data) 1291 1292 ! 1293 !-- Hour 1294 IF ( TRIM( time_fac_type ) == "HOUR" .OR. TRIM( time_fac_type ) == "hour" ) THEN 1295 1296 CALL get_dimension_length( id_emis, emt_att%nhoursyear, 'nhoursyear' ) 1297 ALLOCATE( emt_att%hourly_emis_time_factor(emt_att%ncat,emt_att%nhoursyear) ) 1298 CALL get_variable( id_emis, "emission_time_factors", emt_att%hourly_emis_time_factor, & 1299 1, emt_att%ncat, 1, emt_att%nhoursyear ) 1300 1301 ! 1302 !-- MDH 1303 ELSEIF ( TRIM( time_fac_type ) == "MDH" .OR. TRIM( time_fac_type ) == "mdh" ) THEN 1304 1305 CALL get_dimension_length( id_emis, emt_att%nmonthdayhour, 'nmonthdayhour' ) 1306 ALLOCATE( emt_att%mdh_emis_time_factor(emt_att%ncat,emt_att%nmonthdayhour) ) 1307 CALL get_variable( id_emis, "emission_time_factors", emt_att%mdh_emis_time_factor, & 1308 1, emt_att%ncat, 1, emt_att%nmonthdayhour ) 1309 1310 ! 1311 !-- Error (time factor undefined) 1312 ELSE 1313 1314 message_string = 'We are in the DEFAULT chemistry emissions mode: ' // & 1315 ' !no time-factor type specified!' // & 1316 'Please specify the value of time_fac_type:' // & 1317 ' either "MDH" or "HOUR"' 1318 CALL message( 'netcdf_data_input_chemistry_data', 'CM0200', 2, 2, 0, 6, 0 ) 1319 1320 1321 ENDIF ! time_fac_type 1322 1323 ! 1324 !-- Read in default (LOD1) emissions from chemisty netCDF file per species 1325 1326 ! 1327 !-- Note - At the moment the data is read in per species, but in the future it would be much 1328 !-- more sensible to read in per species per time step to reduce memory consumption 1329 !-- and, to a smaller degree, dimensionality of data exchange (I expect this will be 1330 !-- necessary when the problem size is large). 1331 DO ispec = 1, emt_att%n_emiss_species 1332 1333 ! 1334 !-- Allocate space for species specific emission values. 1335 !-- Note - This array is extended by 1 cell in each horizontal direction to compensate for 1336 !-- an apparent linear offset. The reason of this offset is not known but it has 1337 !-- been determined to take place beyond the scope of this module, and has little to 1338 !-- do with index conventions. 1339 !-- That is, setting the array horizontal limit from nx0:nx1 to 1:(nx1-nx0+1) or 1340 !-- nx0+1:nx1+1 did not result in correct or definite behavior. 1341 !-- This must be looked at at some point by the Hannover team but for now this 1342 !-- workaround is deemed reasonable (ecc 20190417). 1343 IF ( .NOT. ALLOCATED( emt(ispec)%default_emission_data ) ) THEN 1344 ALLOCATE( emt(ispec)%default_emission_data(emt_att%ncat,nys:nyn+1,nxl:nxr+1) ) 1345 ENDIF 1346 ! 1347 !-- Allocate dummy variable w/ index order identical to that shown in the netCDF header 1348 ALLOCATE( dum_var_5d(1,nys:nyn,nxl:nxr,1,emt_att%ncat) ) 1349 ! 1350 !-- Get variable. Be very careful 1351 !-- I am using get_variable_5d_real_dynamic (note logical argument at the end) 1352 !-- 1) use Fortran index convention (i.e., 1 to N) 1353 !-- 2) index order must be in reverse order from above allocation order 1354 CALL get_variable( id_emis, "emission_values", dum_var_5d, 1, ispec, & 1355 nxl+1, nys+1, 1, emt_att%ncat, 1, & 1356 nxr-nxl+1, nyn-nys+1, emt_att%dt_emission, .FALSE. ) 1357 ! 1358 !-- Assign temp array to data structure then deallocate temp array 1359 !-- Note - Indices are shifted from nx0:nx1 to nx0+1:nx1+1 to offset the emission data 1360 !-- array to counter said domain offset. 1361 !-- (ecc 20190417) 1362 DO k = 1, emt_att%ncat 1363 DO j = nys+1, nyn+1 1364 DO i = nxl+1, nxr+1 1365 emt(ispec)%default_emission_data(k,j,i) = dum_var_5d(1,j-1,i-1,1,k) 1404 1366 ENDDO 1405 1367 ENDDO 1406 1407 DEALLOCATE ( dum_var_5d ) 1408 1409 ENDDO ! ispec 1410 ! 1411 !-- UNITS 1412 1413 CALL get_attribute(id_emis,"units",emt_att%units,.FALSE.,"emission_values") 1414 1415 ! 1416 !-- END DEFAULT MODE 1417 1418 1419 ! 1420 !-- START LOD 2 (PRE-PROCESSED MODE) 1421 1422 ELSE IF ( emiss_lod == 2 ) THEN 1423 1424 ! for reference (ecc) 1425 ! ELSE IF (TRIM(mode_emis) == "PRE-PROCESSED" .OR. TRIM(mode_emis) == "pre-processed") THEN 1426 1427 ! 1428 !-- For LOD 2 only VOC and emission data need be read 1429 1430 !------------------------------------------------------------------------------ 1431 !-- NOTE - CHECK ARRAY INDICES FOR READING IN NAMES AND SPECIES 1432 !-- IN LOD2 (PRE-PROCESSED MODE) FOR THE VARIOUS MODE SPLITS 1433 !-- AS ALL ID_EMIS CONDITIONALS HAVE BEEN REMOVED FROM GET_VAR 1434 !-- FUNCTIONS. IN THEORY THIS WOULD MEAN ALL ARRAYS SHOULD BE 1435 !-- READ FROM 0 to N-1 (C CONVENTION) AS OPPOSED TO 1 to N 1436 !-- (FORTRAN CONVENTION). KEEP THIS IN MIND !! 1437 !-- (ecc 20190424) 1438 !------------------------------------------------------------------------------ 1439 1440 DO ispec = 1, emt_att%n_emiss_species 1441 1442 ! 1443 !-- VOC DATA (name and composition) 1444 1445 IF ( TRIM(emt_att%species_name(ispec)) == "VOC" .OR. & 1446 TRIM(emt_att%species_name(ispec)) == "voc" ) THEN 1447 1448 ! 1449 !-- VOC name 1450 CALL get_dimension_length ( id_emis, emt_att%nvoc, 'nvoc' ) 1451 ALLOCATE ( emt_att%voc_name(emt_att%nvoc) ) 1452 CALL get_variable ( id_emis, "emission_voc_name", & 1453 string_values, emt_att%nvoc) 1454 emt_att%voc_name = string_values 1455 IF ( ALLOCATED(string_values) ) DEALLOCATE (string_values) 1456 1457 ! 1458 !-- VOC composition 1459 1460 ALLOCATE ( emt_att%voc_comp(emt_att%ncat,emt_att%nvoc) ) 1461 CALL get_variable ( id_emis, "composition_voc", emt_att%voc_comp, & 1462 1, emt_att%ncat, 1, emt_att%nvoc ) 1463 ENDIF ! VOC 1464 1465 ENDDO ! ispec 1466 1467 ! 1468 !-- EMISSION DATA 1469 1470 CALL get_dimension_length ( id_emis, emt_att%dt_emission, 'time' ) 1471 1472 ! 1473 !-- read in pre-processed (LOD2) emissions from chemisty netCDF file per species 1474 1475 ! 1476 !-- NOTE - at the moment the data is read in per species, but in the future it would 1477 !-- be much more sensible to read in per species per time step to reduce 1478 !-- memory consumption and, to a lesser degree, dimensionality of data exchange 1479 !-- (I expect this will be necessary when the problem size is large) 1480 1481 DO ispec = 1, emt_att%n_emiss_species 1482 1483 ! 1484 !-- allocate space for species specific emission values 1485 !-- NOTE - this array is extended by 1 cell in each horizontal direction 1486 !-- to compensate for an apparent linear offset. The reason of this 1487 !-- offset is not known but it has been determined to take place beyond the 1488 !-- scope of this module, and has little to do with index conventions. 1489 !-- That is, setting the array horizontal limit from nx0:nx1 to 1:(nx1-nx0+1) 1490 !-- or nx0+1:nx1+1 did not result in correct or definite behavior 1491 !-- This must be looked at at some point by the Hannover team but for now 1492 !-- this workaround is deemed reasonable (ecc 20190417) 1493 1494 IF ( .NOT. ALLOCATED( emt(ispec)%preproc_emission_data ) ) THEN 1495 ALLOCATE( emt(ispec)%preproc_emission_data( & 1368 ENDDO 1369 1370 DEALLOCATE( dum_var_5d ) 1371 1372 ENDDO ! ispec 1373 ! 1374 !-- Units 1375 CALL get_attribute( id_emis, "units", emt_att%units, .FALSE., "emission_values" ) 1376 1377 ! 1378 !-- End default mode 1379 1380 1381 ! 1382 !-- Start LOD 2 (pre-processed mode) 1383 ELSEIF ( emiss_lod == 2 ) THEN 1384 1385 ! For reference (ecc) 1386 ! ELSEIF( TRIM( mode_emis ) == "PRE-PROCESSED" .OR. TRIM( mode_emis ) == "pre-processed") THEN 1387 1388 ! 1389 !-- For LOD 2 only VOC and emission data need to be read 1390 !-- Note - Check array indices for reading in names and species in LOD2 (pre-processed mode) 1391 !-- for the various mode splits as all id_emis conditionals have been removed from 1392 !-- get_var_functions. In theory this would mean all arrays should be read from 0 to n-1 1393 !-- (C convention) as opposed to 1 to n (FORTRAN convention). Keep this in mind!! 1394 !-- (ecc 20190424) 1395 DO ispec = 1, emt_att%n_emiss_species 1396 1397 ! 1398 !-- VOC data (name and composition) 1399 IF ( TRIM( emt_att%species_name(ispec) ) == "VOC" .OR. & 1400 TRIM( emt_att%species_name(ispec) ) == "voc" ) THEN 1401 1402 ! 1403 !-- VOC name 1404 CALL get_dimension_length( id_emis, emt_att%nvoc, 'nvoc' ) 1405 ALLOCATE( emt_att%voc_name(emt_att%nvoc) ) 1406 CALL get_variable( id_emis, "emission_voc_name", string_values, emt_att%nvoc ) 1407 emt_att%voc_name = string_values 1408 IF ( ALLOCATED( string_values ) ) DEALLOCATE( string_values ) 1409 1410 ! 1411 !-- VOC composition 1412 ALLOCATE( emt_att%voc_comp(emt_att%ncat,emt_att%nvoc) ) 1413 CALL get_variable( id_emis, "composition_voc", emt_att%voc_comp, 1, emt_att%ncat, & 1414 1, emt_att%nvoc ) 1415 ENDIF ! VOC 1416 1417 ENDDO ! ispec 1418 1419 ! 1420 !-- Emission data 1421 CALL get_dimension_length( id_emis, emt_att%dt_emission, 'time' ) 1422 1423 ! 1424 !-- Read in pre-processed (LOD2) emissions from chemisty netCDF file per species 1425 1426 ! 1427 !-- Note - At the moment the data is read in per species, but in the future it would be much 1428 !-- more sensible to read in per species per time step to reduce memory consumption 1429 !-- and, to a smaller degree, dimensionality of data exchange (I expect this will be 1430 !-- necessary when the problem size is large). 1431 DO ispec = 1, emt_att%n_emiss_species 1432 1433 ! 1434 !-- Allocate space for species specific emission values. 1435 !-- Note - This array is extended by 1 cell in each horizontal direction to compensate for 1436 !-- an apparent linear offset. The reason of this offset is not known but it has 1437 !-- been determined to take place beyond the scope of this module, and has little to 1438 !-- do with index conventions. 1439 !-- That is, setting the array horizontal limit from nx0:nx1 to 1:(nx1-nx0+1) or 1440 !-- nx0+1:nx1+1 did not result in correct or definite behavior. 1441 !-- This must be looked at at some point by the Hannover team but for now this 1442 !-- workaround is deemed reasonable (ecc 20190417). 1443 1444 IF ( .NOT. ALLOCATED( emt(ispec)%preproc_emission_data ) ) THEN 1445 ALLOCATE( emt(ispec)%preproc_emission_data( & 1496 1446 emt_att%dt_emission, 1, nys:nyn+1, nxl:nxr+1) ) 1497 ENDIF 1498 ! 1499 !-- allocate dummy variable w/ index order identical to that shown in the netCDF header 1500 1501 ALLOCATE ( dum_var_5d(emt_att%dt_emission,1,nys:nyn,nxl:nxr,1) ) 1502 ! 1503 !-- get variable. be very careful 1504 !-- I am using get_variable_5d_real_dynamic (note logical argument at the end) 1505 !-- 1) use Fortran index convention (i.e., 1 to N) 1506 !-- 2) index order must be in reverse order from above allocation order 1507 1508 CALL get_variable ( id_emis, "emission_values", dum_var_5d, & 1509 ispec, nxl+1, nys+1, 1, 1, & 1510 1, nxr-nxl+1, nyn-nys+1, 1, emt_att%dt_emission, & 1511 .FALSE. ) 1512 ! 1513 !-- assign temp array to data structure then deallocate temp array 1514 !-- NOTE - indices are shifted from nx0:nx1 to nx0+1:nx1+1 to offset 1515 !-- the emission data array to counter said unkonwn offset 1516 !-- (ecc 20190417) 1517 1518 DO k = 1, emt_att%dt_emission 1519 DO j = nys+1, nyn+1 1520 DO i = nxl+1, nxr+1 1521 emt(ispec)%preproc_emission_data(k,1,j,i) = dum_var_5d(k,1,j-1,i-1,1) 1522 ENDDO 1447 ENDIF 1448 ! 1449 !-- Allocate dummy variable w/ index order identical to that shown in the netCDF header 1450 ALLOCATE( dum_var_5d(emt_att%dt_emission,1,nys:nyn,nxl:nxr,1) ) 1451 ! 1452 !-- Get variable. Be very careful. 1453 !-- I am using get_variable_5d_real_dynamic (note logical argument at the end) 1454 !-- 1) use Fortran index convention (i.e., 1 to N) 1455 !-- 2) index order must be in reverse order from above allocation order 1456 CALL get_variable( id_emis, "emission_values", dum_var_5d, ispec, & 1457 nxl+1, nys+1, 1, 1, 1, & 1458 nxr-nxl+1, nyn-nys+1, 1, emt_att%dt_emission, .FALSE. ) 1459 ! 1460 !-- Assign temp array to data structure then deallocate temp array. 1461 !-- Note - Indices are shifted from nx0:nx1 to nx0+1:nx1+1 to offset the emission data 1462 !-- array to counter mentioned unkonwn offset. 1463 !-- (ecc 20190417) 1464 1465 DO k = 1, emt_att%dt_emission 1466 DO j = nys+1, nyn+1 1467 DO i = nxl+1, nxr+1 1468 emt(ispec)%preproc_emission_data(k,1,j,i) = dum_var_5d(k,1,j-1,i-1,1) 1523 1469 ENDDO 1524 1470 ENDDO 1525 1526 DEALLOCATE ( dum_var_5d ) 1527 1528 ENDDO ! ispec 1529 ! 1530 ! -- UNITS1531 1532 CALL get_attribute( id_emis, "units", emt_att%units, .FALSE. , "emission_values" )1533 1534 1535 1536 CALL close_input_file (id_emis)1471 ENDDO 1472 1473 DEALLOCATE( dum_var_5d ) 1474 1475 ENDDO ! ispec 1476 ! 1477 !-- Units 1478 CALL get_attribute( id_emis, "units", emt_att%units, .FALSE. , "emission_values" ) 1479 1480 ENDIF ! LOD1 & LOD2 (default and pre-processed mode) 1481 1482 CALL close_input_file( id_emis ) 1537 1483 1538 1484 #endif 1539 1485 1540 1541 1542 1543 1544 1545 !------------------------------------------------------------------------------ !1486 ENDIF ! LOD0 (parameterized mode) 1487 1488 END SUBROUTINE netcdf_data_input_chemistry_data 1489 1490 1491 !--------------------------------------------------------------------------------------------------! 1546 1492 ! Description: 1547 1493 ! ------------ 1548 1494 !> Reads surface classification data, such as vegetation and soil type, etc. . 1549 !------------------------------------------------------------------------------ !1550 1551 1552 USE control_parameters,&1553 1554 1555 USE exchange_horiz_mod,&1556 1557 1558 USE indices,&1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 ! 1573 !-- 1574 1575 ! 1576 !-- 1577 1578 ! 1579 !-- Skip the following if no land-surface or urban-surface module are1580 !-- applied. This case, no one ofthe following variables is used anyway.1581 IF (.NOT. land_surface .AND. .NOT. urban_surface ) RETURN1495 !--------------------------------------------------------------------------------------------------! 1496 SUBROUTINE netcdf_data_input_surface_data 1497 1498 USE control_parameters, & 1499 ONLY: land_surface, urban_surface 1500 1501 USE exchange_horiz_mod, & 1502 ONLY: exchange_horiz_2d, exchange_horiz_2d_byte, exchange_horiz_2d_int 1503 1504 USE indices, & 1505 ONLY: nbgp, nxl, nxr, nyn, nys 1506 1507 1508 IMPLICIT NONE 1509 1510 CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names in static input file 1511 1512 INTEGER(iwp) :: id_surf !< NetCDF id of input file 1513 INTEGER(iwp) :: k !< running index along z-direction 1514 INTEGER(iwp) :: k2 !< running index 1515 INTEGER(iwp) :: num_vars !< number of variables in input file 1516 INTEGER(iwp) :: nz_soil !< number of soil layers in file 1517 1518 ! 1519 !-- If not static input file is available, skip this routine 1520 IF ( .NOT. input_pids_static ) RETURN 1521 ! 1522 !-- Measure CPU time 1523 CALL cpu_log( log_point_s(82), 'NetCDF input', 'start' ) 1524 ! 1525 !-- Skip the following if no land-surface or urban-surface module are applied. This case, no one of 1526 !-- the following variables is used anyway. 1527 IF ( .NOT. land_surface .AND. .NOT. urban_surface ) RETURN 1582 1528 1583 1529 #if defined ( __netcdf ) 1584 1530 ! 1585 !-- Open file in read-only mode 1586 CALL open_read_file( TRIM( input_file_static ) // & 1587 TRIM( coupling_char ) , id_surf ) 1588 ! 1589 !-- Inquire all variable names. 1590 !-- This will be used to check whether an optional input variable exist 1591 !-- or not. 1592 CALL inquire_num_variables( id_surf, num_vars ) 1593 1594 ALLOCATE( var_names(1:num_vars) ) 1595 CALL inquire_variable_names( id_surf, var_names ) 1596 ! 1597 !-- Read vegetation type and required attributes 1598 IF ( check_existence( var_names, 'vegetation_type' ) ) THEN 1599 vegetation_type_f%from_file = .TRUE. 1600 CALL get_attribute( id_surf, char_fill, & 1601 vegetation_type_f%fill, & 1602 .FALSE., 'vegetation_type' ) 1603 1604 ALLOCATE ( vegetation_type_f%var(nys:nyn,nxl:nxr) ) 1605 1606 CALL get_variable( id_surf, 'vegetation_type', & 1607 vegetation_type_f%var, nxl, nxr, nys, nyn ) 1608 ELSE 1609 vegetation_type_f%from_file = .FALSE. 1531 !-- Open file in read-only mode 1532 CALL open_read_file( TRIM( input_file_static ) // TRIM( coupling_char ) , id_surf ) 1533 ! 1534 !-- Inquire all variable names. 1535 !-- This will be used to check whether an optional input variable exists or not. 1536 CALL inquire_num_variables( id_surf, num_vars ) 1537 1538 ALLOCATE( var_names(1:num_vars) ) 1539 CALL inquire_variable_names( id_surf, var_names ) 1540 ! 1541 !-- Read vegetation type and required attributes 1542 IF ( check_existence( var_names, 'vegetation_type' ) ) THEN 1543 vegetation_type_f%from_file = .TRUE. 1544 CALL get_attribute( id_surf, char_fill, vegetation_type_f%fill, .FALSE., 'vegetation_type' ) 1545 1546 ALLOCATE( vegetation_type_f%var(nys:nyn,nxl:nxr) ) 1547 1548 CALL get_variable( id_surf, 'vegetation_type', vegetation_type_f%var, nxl, nxr, nys, nyn ) 1549 ELSE 1550 vegetation_type_f%from_file = .FALSE. 1551 ENDIF 1552 1553 ! 1554 !-- Read soil type and required attributes 1555 IF ( check_existence( var_names, 'soil_type' ) ) THEN 1556 soil_type_f%from_file = .TRUE. 1557 ! 1558 !-- Note, lod is currently not on file; skip for the moment 1559 ! CALL get_attribute( id_surf, char_lod, & 1560 ! soil_type_f%lod, & 1561 ! .FALSE., 'soil_type' ) 1562 CALL get_attribute( id_surf, char_fill, soil_type_f%fill, .FALSE., 'soil_type' ) 1563 1564 IF ( soil_type_f%lod == 1 ) THEN 1565 1566 ALLOCATE( soil_type_f%var_2d(nys:nyn,nxl:nxr) ) 1567 1568 CALL get_variable( id_surf, 'soil_type', soil_type_f%var_2d, nxl, nxr, nys, nyn ) 1569 1570 ELSEIF ( soil_type_f%lod == 2 ) THEN 1571 ! 1572 !-- Obtain number of soil layers from file. 1573 CALL get_dimension_length( id_surf, nz_soil, 'zsoil' ) 1574 1575 ALLOCATE( soil_type_f%var_3d(0:nz_soil,nys:nyn,nxl:nxr) ) 1576 1577 CALL get_variable( id_surf, 'soil_type', soil_type_f%var_3d, nxl, nxr, nys, nyn, 0, & 1578 nz_soil ) 1579 1610 1580 ENDIF 1611 1612 ! 1613 !-- Read soil type and required attributes 1614 IF ( check_existence( var_names, 'soil_type' ) ) THEN 1615 soil_type_f%from_file = .TRUE. 1616 ! 1617 !-- Note, lod is currently not on file; skip for the moment 1618 ! CALL get_attribute( id_surf, char_lod, & 1619 ! soil_type_f%lod, & 1620 ! .FALSE., 'soil_type' ) 1621 CALL get_attribute( id_surf, char_fill, & 1622 soil_type_f%fill, & 1623 .FALSE., 'soil_type' ) 1624 1625 IF ( soil_type_f%lod == 1 ) THEN 1626 1627 ALLOCATE ( soil_type_f%var_2d(nys:nyn,nxl:nxr) ) 1628 1629 CALL get_variable( id_surf, 'soil_type', soil_type_f%var_2d, & 1630 nxl, nxr, nys, nyn ) 1631 1632 ELSEIF ( soil_type_f%lod == 2 ) THEN 1633 ! 1634 !-- Obtain number of soil layers from file. 1635 CALL get_dimension_length( id_surf, nz_soil, 'zsoil' ) 1636 1637 ALLOCATE ( soil_type_f%var_3d(0:nz_soil,nys:nyn,nxl:nxr) ) 1638 1639 CALL get_variable( id_surf, 'soil_type', soil_type_f%var_3d, & 1640 nxl, nxr, nys, nyn, 0, nz_soil ) 1641 1642 ENDIF 1643 ELSE 1644 soil_type_f%from_file = .FALSE. 1581 ELSE 1582 soil_type_f%from_file = .FALSE. 1583 ENDIF 1584 1585 ! 1586 !-- Read pavement type and required attributes 1587 IF ( check_existence( var_names, 'pavement_type' ) ) THEN 1588 pavement_type_f%from_file = .TRUE. 1589 CALL get_attribute( id_surf, char_fill, pavement_type_f%fill, .FALSE., 'pavement_type' ) 1590 1591 ALLOCATE( pavement_type_f%var(nys:nyn,nxl:nxr) ) 1592 1593 CALL get_variable( id_surf, 'pavement_type', pavement_type_f%var, nxl, nxr, nys, nyn ) 1594 ELSE 1595 pavement_type_f%from_file = .FALSE. 1596 ENDIF 1597 1598 ! 1599 !-- Read water type and required attributes 1600 IF ( check_existence( var_names, 'water_type' ) ) THEN 1601 water_type_f%from_file = .TRUE. 1602 CALL get_attribute( id_surf, char_fill, water_type_f%fill, .FALSE., 'water_type' ) 1603 1604 ALLOCATE( water_type_f%var(nys:nyn,nxl:nxr) ) 1605 1606 CALL get_variable( id_surf, 'water_type', water_type_f%var, nxl, nxr, nys, nyn ) 1607 1608 ELSE 1609 water_type_f%from_file = .FALSE. 1610 ENDIF 1611 ! 1612 !-- Read relative surface fractions of vegetation, pavement and water. 1613 IF ( check_existence( var_names, 'surface_fraction' ) ) THEN 1614 surface_fraction_f%from_file = .TRUE. 1615 CALL get_attribute( id_surf, char_fill, surface_fraction_f%fill, .FALSE., 'surface_fraction') 1616 ! 1617 !-- Inquire number of surface fractions 1618 CALL get_dimension_length( id_surf, surface_fraction_f%nf, 'nsurface_fraction' ) 1619 ! 1620 !-- Allocate dimension array and input array for surface fractions 1621 ALLOCATE( surface_fraction_f%nfracs(0:surface_fraction_f%nf-1) ) 1622 ALLOCATE( surface_fraction_f%frac(0:surface_fraction_f%nf-1,nys:nyn,nxl:nxr) ) 1623 ! 1624 !-- Get dimension of surface fractions 1625 CALL get_variable( id_surf, 'nsurface_fraction', surface_fraction_f%nfracs ) 1626 ! 1627 !-- Read surface fractions 1628 CALL get_variable( id_surf, 'surface_fraction', surface_fraction_f%frac, & 1629 nxl, nxr, nys, nyn, 0, surface_fraction_f%nf-1 ) 1630 ELSE 1631 surface_fraction_f%from_file = .FALSE. 1632 ENDIF 1633 ! 1634 !-- Read building parameters and related information 1635 IF ( check_existence( var_names, 'building_pars' ) ) THEN 1636 building_pars_f%from_file = .TRUE. 1637 CALL get_attribute( id_surf, char_fill, building_pars_f%fill, .FALSE., 'building_pars' ) 1638 ! 1639 !-- Inquire number of building parameters 1640 CALL get_dimension_length( id_surf, building_pars_f%np, 'nbuilding_pars' ) 1641 ! 1642 !-- Allocate dimension array and input array for building parameters 1643 ALLOCATE( building_pars_f%pars(0:building_pars_f%np-1) ) 1644 ALLOCATE( building_pars_f%pars_xy(0:building_pars_f%np-1,nys:nyn,nxl:nxr) ) 1645 ! 1646 !-- Get dimension of building parameters 1647 CALL get_variable( id_surf, 'nbuilding_pars', building_pars_f%pars ) 1648 ! 1649 !-- Read building_pars 1650 CALL get_variable( id_surf, 'building_pars', building_pars_f%pars_xy, & 1651 nxl, nxr, nys, nyn, 0, building_pars_f%np-1 ) 1652 ELSE 1653 building_pars_f%from_file = .FALSE. 1654 ENDIF 1655 1656 ! 1657 !-- Read building surface parameters 1658 IF ( check_existence( var_names, 'building_surface_pars' ) ) THEN 1659 building_surface_pars_f%from_file = .TRUE. 1660 CALL get_attribute( id_surf, char_fill, building_surface_pars_f%fill, .FALSE., & 1661 'building_surface_pars' ) 1662 ! 1663 !-- Read building_surface_pars 1664 CALL get_variable_surf( id_surf, 'building_surface_pars', building_surface_pars_f ) 1665 ELSE 1666 building_surface_pars_f%from_file = .FALSE. 1667 ENDIF 1668 1669 ! 1670 !-- Read albedo type and required attributes 1671 IF ( check_existence( var_names, 'albedo_type' ) ) THEN 1672 albedo_type_f%from_file = .TRUE. 1673 CALL get_attribute( id_surf, char_fill, albedo_type_f%fill, .FALSE., 'albedo_type' ) 1674 1675 ALLOCATE( albedo_type_f%var(nys:nyn,nxl:nxr) ) 1676 1677 CALL get_variable( id_surf, 'albedo_type', albedo_type_f%var, nxl, nxr, nys, nyn ) 1678 ELSE 1679 albedo_type_f%from_file = .FALSE. 1680 ENDIF 1681 1682 ! 1683 !-- Read albedo parameters and related information 1684 IF ( check_existence( var_names, 'albedo_pars' ) ) THEN 1685 albedo_pars_f%from_file = .TRUE. 1686 CALL get_attribute( id_surf, char_fill, albedo_pars_f%fill, .FALSE., 'albedo_pars' ) 1687 ! 1688 !-- Inquire number of albedo parameters 1689 CALL get_dimension_length( id_surf, albedo_pars_f%np, 'nalbedo_pars' ) 1690 ! 1691 !-- Allocate dimension array and input array for albedo parameters 1692 ALLOCATE( albedo_pars_f%pars(0:albedo_pars_f%np-1) ) 1693 ALLOCATE( albedo_pars_f%pars_xy(0:albedo_pars_f%np-1,nys:nyn,nxl:nxr) ) 1694 ! 1695 !-- Get dimension of albedo parameters 1696 CALL get_variable( id_surf, 'nalbedo_pars', albedo_pars_f%pars ) 1697 1698 CALL get_variable( id_surf, 'albedo_pars', albedo_pars_f%pars_xy, & 1699 nxl, nxr, nys, nyn, 0, albedo_pars_f%np-1 ) 1700 ELSE 1701 albedo_pars_f%from_file = .FALSE. 1702 ENDIF 1703 1704 ! 1705 !-- Read pavement parameters and related information 1706 IF ( check_existence( var_names, 'pavement_pars' ) ) THEN 1707 pavement_pars_f%from_file = .TRUE. 1708 CALL get_attribute( id_surf, char_fill, pavement_pars_f%fill, .FALSE., 'pavement_pars' ) 1709 ! 1710 !-- Inquire number of pavement parameters 1711 CALL get_dimension_length( id_surf, pavement_pars_f%np, 'npavement_pars' ) 1712 ! 1713 !-- Allocate dimension array and input array for pavement parameters 1714 ALLOCATE( pavement_pars_f%pars(0:pavement_pars_f%np-1) ) 1715 ALLOCATE( pavement_pars_f%pars_xy(0:pavement_pars_f%np-1,nys:nyn,nxl:nxr) ) 1716 ! 1717 !-- Get dimension of pavement parameters 1718 CALL get_variable( id_surf, 'npavement_pars', pavement_pars_f%pars ) 1719 1720 CALL get_variable( id_surf, 'pavement_pars', pavement_pars_f%pars_xy, & 1721 nxl, nxr, nys, nyn, 0, pavement_pars_f%np-1 ) 1722 ELSE 1723 pavement_pars_f%from_file = .FALSE. 1724 ENDIF 1725 1726 ! 1727 !-- Read pavement subsurface parameters and related information 1728 IF ( check_existence( var_names, 'pavement_subsurface_pars' ) ) THEN 1729 pavement_subsurface_pars_f%from_file = .TRUE. 1730 CALL get_attribute( id_surf, char_fill, pavement_subsurface_pars_f%fill, .FALSE., & 1731 'pavement_subsurface_pars' ) 1732 ! 1733 !-- Inquire number of parameters 1734 CALL get_dimension_length( id_surf, pavement_subsurface_pars_f%np, & 1735 'npavement_subsurface_pars' ) 1736 ! 1737 !-- Inquire number of soil layers 1738 CALL get_dimension_length( id_surf, pavement_subsurface_pars_f%nz, 'zsoil' ) 1739 ! 1740 !-- Allocate dimension array and input array for pavement parameters 1741 ALLOCATE( pavement_subsurface_pars_f%pars(0:pavement_subsurface_pars_f%np-1) ) 1742 ALLOCATE( pavement_subsurface_pars_f%pars_xyz(0:pavement_subsurface_pars_f%np-1, & 1743 0:pavement_subsurface_pars_f%nz-1, & 1744 nys:nyn,nxl:nxr) ) 1745 ! 1746 !-- Get dimension of pavement parameters 1747 CALL get_variable( id_surf, 'npavement_subsurface_pars', pavement_subsurface_pars_f%pars ) 1748 1749 CALL get_variable( id_surf, 'pavement_subsurface_pars', pavement_subsurface_pars_f%pars_xyz,& 1750 nxl, nxr, nys, nyn, 0, pavement_subsurface_pars_f%nz-1, & 1751 0, pavement_subsurface_pars_f%np-1 ) 1752 ELSE 1753 pavement_subsurface_pars_f%from_file = .FALSE. 1754 ENDIF 1755 1756 1757 ! 1758 !-- Read vegetation parameters and related information 1759 IF ( check_existence( var_names, 'vegetation_pars' ) ) THEN 1760 vegetation_pars_f%from_file = .TRUE. 1761 CALL get_attribute( id_surf, char_fill, vegetation_pars_f%fill, .FALSE., 'vegetation_pars' ) 1762 ! 1763 !-- Inquire number of vegetation parameters 1764 CALL get_dimension_length( id_surf, vegetation_pars_f%np, 'nvegetation_pars' ) 1765 ! 1766 !-- Allocate dimension array and input array for surface fractions 1767 ALLOCATE( vegetation_pars_f%pars(0:vegetation_pars_f%np-1) ) 1768 ALLOCATE( vegetation_pars_f%pars_xy(0:vegetation_pars_f%np-1,nys:nyn,nxl:nxr) ) 1769 ! 1770 !-- Get dimension of the parameters 1771 CALL get_variable( id_surf, 'nvegetation_pars', vegetation_pars_f%pars ) 1772 CALL get_variable( id_surf, 'vegetation_pars', vegetation_pars_f%pars_xy, & 1773 nxl, nxr, nys, nyn, 0, vegetation_pars_f%np-1 ) 1774 ELSE 1775 vegetation_pars_f%from_file = .FALSE. 1776 ENDIF 1777 1778 ! 1779 !-- Read root parameters/distribution and related information 1780 IF ( check_existence( var_names, 'soil_pars' ) ) THEN 1781 soil_pars_f%from_file = .TRUE. 1782 CALL get_attribute( id_surf, char_fill, soil_pars_f%fill, .FALSE., 'soil_pars' ) 1783 CALL get_attribute( id_surf, char_lod, soil_pars_f%lod, .FALSE., 'soil_pars' ) 1784 1785 ! 1786 !-- Inquire number of soil parameters 1787 CALL get_dimension_length( id_surf, soil_pars_f%np, 'nsoil_pars' ) 1788 ! 1789 !-- Read parameters array 1790 ALLOCATE( soil_pars_f%pars(0:soil_pars_f%np-1) ) 1791 CALL get_variable( id_surf, 'nsoil_pars', soil_pars_f%pars ) 1792 1793 ! 1794 !-- In case of level of detail 2, also inquire number of vertical soil layers, allocate memory 1795 !-- and read the respective dimension. 1796 IF ( soil_pars_f%lod == 2 ) THEN 1797 CALL get_dimension_length( id_surf, soil_pars_f%nz, 'zsoil' ) 1798 1799 ALLOCATE( soil_pars_f%layers(0:soil_pars_f%nz-1) ) 1800 CALL get_variable( id_surf, 'zsoil', soil_pars_f%layers ) 1801 1645 1802 ENDIF 1646 1803 1647 1804 ! 1648 !-- Read pavement type and required attributes 1649 IF ( check_existence( var_names, 'pavement_type' ) ) THEN 1650 pavement_type_f%from_file = .TRUE. 1651 CALL get_attribute( id_surf, char_fill, & 1652 pavement_type_f%fill, .FALSE., & 1653 'pavement_type' ) 1654 1655 ALLOCATE ( pavement_type_f%var(nys:nyn,nxl:nxr) ) 1656 1657 CALL get_variable( id_surf, 'pavement_type', pavement_type_f%var, & 1658 nxl, nxr, nys, nyn ) 1659 ELSE 1660 pavement_type_f%from_file = .FALSE. 1805 !-- Read soil parameters, depending on level of detail 1806 IF ( soil_pars_f%lod == 1 ) THEN 1807 ALLOCATE( soil_pars_f%pars_xy(0:soil_pars_f%np-1,nys:nyn,nxl:nxr) ) 1808 1809 CALL get_variable( id_surf, 'soil_pars', soil_pars_f%pars_xy, & 1810 nxl, nxr, nys, nyn, 0, soil_pars_f%np-1 ) 1811 1812 ELSEIF ( soil_pars_f%lod == 2 ) THEN 1813 ALLOCATE( soil_pars_f%pars_xyz(0:soil_pars_f%np-1,0:soil_pars_f%nz-1,nys:nyn,nxl:nxr) ) 1814 CALL get_variable( id_surf, 'soil_pars', soil_pars_f%pars_xyz, & 1815 nxl, nxr, nys, nyn, 0, soil_pars_f%nz-1, 0, soil_pars_f%np-1 ) 1661 1816 ENDIF 1662 1663 ! 1664 !-- Read water type and required attributes 1665 IF ( check_existence( var_names, 'water_type' ) ) THEN 1666 water_type_f%from_file = .TRUE. 1667 CALL get_attribute( id_surf, char_fill, water_type_f%fill, & 1668 .FALSE., 'water_type' ) 1669 1670 ALLOCATE ( water_type_f%var(nys:nyn,nxl:nxr) ) 1671 1672 CALL get_variable( id_surf, 'water_type', water_type_f%var, & 1673 nxl, nxr, nys, nyn ) 1674 1675 ELSE 1676 water_type_f%from_file = .FALSE. 1677 ENDIF 1678 ! 1679 !-- Read relative surface fractions of vegetation, pavement and water. 1680 IF ( check_existence( var_names, 'surface_fraction' ) ) THEN 1681 surface_fraction_f%from_file = .TRUE. 1682 CALL get_attribute( id_surf, char_fill, & 1683 surface_fraction_f%fill, & 1684 .FALSE., 'surface_fraction' ) 1685 ! 1686 !-- Inquire number of surface fractions 1687 CALL get_dimension_length( id_surf, & 1688 surface_fraction_f%nf, & 1689 'nsurface_fraction' ) 1690 ! 1691 !-- Allocate dimension array and input array for surface fractions 1692 ALLOCATE( surface_fraction_f%nfracs(0:surface_fraction_f%nf-1) ) 1693 ALLOCATE( surface_fraction_f%frac(0:surface_fraction_f%nf-1, & 1694 nys:nyn,nxl:nxr) ) 1695 ! 1696 !-- Get dimension of surface fractions 1697 CALL get_variable( id_surf, 'nsurface_fraction', & 1698 surface_fraction_f%nfracs ) 1699 ! 1700 !-- Read surface fractions 1701 CALL get_variable( id_surf, 'surface_fraction', & 1702 surface_fraction_f%frac, nxl, nxr, nys, nyn, & 1703 0, surface_fraction_f%nf-1 ) 1704 ELSE 1705 surface_fraction_f%from_file = .FALSE. 1706 ENDIF 1707 ! 1708 !-- Read building parameters and related information 1709 IF ( check_existence( var_names, 'building_pars' ) ) THEN 1710 building_pars_f%from_file = .TRUE. 1711 CALL get_attribute( id_surf, char_fill, & 1712 building_pars_f%fill, & 1713 .FALSE., 'building_pars' ) 1714 ! 1715 !-- Inquire number of building parameters 1716 CALL get_dimension_length( id_surf, & 1717 building_pars_f%np, & 1718 'nbuilding_pars' ) 1719 ! 1720 !-- Allocate dimension array and input array for building parameters 1721 ALLOCATE( building_pars_f%pars(0:building_pars_f%np-1) ) 1722 ALLOCATE( building_pars_f%pars_xy(0:building_pars_f%np-1, & 1723 nys:nyn,nxl:nxr) ) 1724 ! 1725 !-- Get dimension of building parameters 1726 CALL get_variable( id_surf, 'nbuilding_pars', & 1727 building_pars_f%pars ) 1728 ! 1729 !-- Read building_pars 1730 CALL get_variable( id_surf, 'building_pars', & 1731 building_pars_f%pars_xy, nxl, nxr, nys, nyn, & 1732 0, building_pars_f%np-1 ) 1733 ELSE 1734 building_pars_f%from_file = .FALSE. 1735 ENDIF 1736 ! 1737 !-- Read building surface parameters 1738 IF ( check_existence( var_names, 'building_surface_pars' ) ) THEN 1739 building_surface_pars_f%from_file = .TRUE. 1740 CALL get_attribute( id_surf, char_fill, & 1741 building_surface_pars_f%fill, & 1742 .FALSE., 'building_surface_pars' ) 1743 ! 1744 !-- Read building_surface_pars 1745 CALL get_variable_surf( id_surf, 'building_surface_pars', & 1746 building_surface_pars_f ) 1747 ELSE 1748 building_surface_pars_f%from_file = .FALSE. 1749 ENDIF 1750 1751 ! 1752 !-- Read albedo type and required attributes 1753 IF ( check_existence( var_names, 'albedo_type' ) ) THEN 1754 albedo_type_f%from_file = .TRUE. 1755 CALL get_attribute( id_surf, char_fill, albedo_type_f%fill, & 1756 .FALSE., 'albedo_type' ) 1757 1758 ALLOCATE ( albedo_type_f%var(nys:nyn,nxl:nxr) ) 1759 1760 CALL get_variable( id_surf, 'albedo_type', albedo_type_f%var, & 1761 nxl, nxr, nys, nyn ) 1762 ELSE 1763 albedo_type_f%from_file = .FALSE. 1764 ENDIF 1765 ! 1766 !-- Read albedo parameters and related information 1767 IF ( check_existence( var_names, 'albedo_pars' ) ) THEN 1768 albedo_pars_f%from_file = .TRUE. 1769 CALL get_attribute( id_surf, char_fill, albedo_pars_f%fill, & 1770 .FALSE., 'albedo_pars' ) 1771 ! 1772 !-- Inquire number of albedo parameters 1773 CALL get_dimension_length( id_surf, & 1774 albedo_pars_f%np, & 1775 'nalbedo_pars' ) 1776 ! 1777 !-- Allocate dimension array and input array for albedo parameters 1778 ALLOCATE( albedo_pars_f%pars(0:albedo_pars_f%np-1) ) 1779 ALLOCATE( albedo_pars_f%pars_xy(0:albedo_pars_f%np-1, & 1780 nys:nyn,nxl:nxr) ) 1781 ! 1782 !-- Get dimension of albedo parameters 1783 CALL get_variable( id_surf, 'nalbedo_pars', albedo_pars_f%pars ) 1784 1785 CALL get_variable( id_surf, 'albedo_pars', albedo_pars_f%pars_xy, & 1786 nxl, nxr, nys, nyn, & 1787 0, albedo_pars_f%np-1 ) 1788 ELSE 1789 albedo_pars_f%from_file = .FALSE. 1790 ENDIF 1791 1792 ! 1793 !-- Read pavement parameters and related information 1794 IF ( check_existence( var_names, 'pavement_pars' ) ) THEN 1795 pavement_pars_f%from_file = .TRUE. 1796 CALL get_attribute( id_surf, char_fill, & 1797 pavement_pars_f%fill, & 1798 .FALSE., 'pavement_pars' ) 1799 ! 1800 !-- Inquire number of pavement parameters 1801 CALL get_dimension_length( id_surf, & 1802 pavement_pars_f%np, & 1803 'npavement_pars' ) 1804 ! 1805 !-- Allocate dimension array and input array for pavement parameters 1806 ALLOCATE( pavement_pars_f%pars(0:pavement_pars_f%np-1) ) 1807 ALLOCATE( pavement_pars_f%pars_xy(0:pavement_pars_f%np-1, & 1808 nys:nyn,nxl:nxr) ) 1809 ! 1810 !-- Get dimension of pavement parameters 1811 CALL get_variable( id_surf, 'npavement_pars', pavement_pars_f%pars ) 1812 1813 CALL get_variable( id_surf, 'pavement_pars', pavement_pars_f%pars_xy,& 1814 nxl, nxr, nys, nyn, & 1815 0, pavement_pars_f%np-1 ) 1816 ELSE 1817 pavement_pars_f%from_file = .FALSE. 1818 ENDIF 1819 1820 ! 1821 !-- Read pavement subsurface parameters and related information 1822 IF ( check_existence( var_names, 'pavement_subsurface_pars' ) ) & 1823 THEN 1824 pavement_subsurface_pars_f%from_file = .TRUE. 1825 CALL get_attribute( id_surf, char_fill, & 1826 pavement_subsurface_pars_f%fill, & 1827 .FALSE., 'pavement_subsurface_pars' ) 1828 ! 1829 !-- Inquire number of parameters 1830 CALL get_dimension_length( id_surf, & 1831 pavement_subsurface_pars_f%np, & 1832 'npavement_subsurface_pars' ) 1833 ! 1834 !-- Inquire number of soil layers 1835 CALL get_dimension_length( id_surf, & 1836 pavement_subsurface_pars_f%nz, & 1837 'zsoil' ) 1838 ! 1839 !-- Allocate dimension array and input array for pavement parameters 1840 ALLOCATE( pavement_subsurface_pars_f%pars & 1841 (0:pavement_subsurface_pars_f%np-1) ) 1842 ALLOCATE( pavement_subsurface_pars_f%pars_xyz & 1843 (0:pavement_subsurface_pars_f%np-1, & 1844 0:pavement_subsurface_pars_f%nz-1, & 1845 nys:nyn,nxl:nxr) ) 1846 ! 1847 !-- Get dimension of pavement parameters 1848 CALL get_variable( id_surf, 'npavement_subsurface_pars', & 1849 pavement_subsurface_pars_f%pars ) 1850 1851 CALL get_variable( id_surf, 'pavement_subsurface_pars', & 1852 pavement_subsurface_pars_f%pars_xyz, & 1853 nxl, nxr, nys, nyn, & 1854 0, pavement_subsurface_pars_f%nz-1, & 1855 0, pavement_subsurface_pars_f%np-1 ) 1856 ELSE 1857 pavement_subsurface_pars_f%from_file = .FALSE. 1858 ENDIF 1859 1860 1861 ! 1862 !-- Read vegetation parameters and related information 1863 IF ( check_existence( var_names, 'vegetation_pars' ) ) THEN 1864 vegetation_pars_f%from_file = .TRUE. 1865 CALL get_attribute( id_surf, char_fill, & 1866 vegetation_pars_f%fill, & 1867 .FALSE., 'vegetation_pars' ) 1868 ! 1869 !-- Inquire number of vegetation parameters 1870 CALL get_dimension_length( id_surf, & 1871 vegetation_pars_f%np, & 1872 'nvegetation_pars' ) 1873 ! 1874 !-- Allocate dimension array and input array for surface fractions 1875 ALLOCATE( vegetation_pars_f%pars(0:vegetation_pars_f%np-1) ) 1876 ALLOCATE( vegetation_pars_f%pars_xy(0:vegetation_pars_f%np-1, & 1877 nys:nyn,nxl:nxr) ) 1878 ! 1879 !-- Get dimension of the parameters 1880 CALL get_variable( id_surf, 'nvegetation_pars', & 1881 vegetation_pars_f%pars ) 1882 1883 CALL get_variable( id_surf, 'vegetation_pars', & 1884 vegetation_pars_f%pars_xy, nxl, nxr, nys, nyn, & 1885 0, vegetation_pars_f%np-1 ) 1886 ELSE 1887 vegetation_pars_f%from_file = .FALSE. 1888 ENDIF 1889 1890 ! 1891 !-- Read root parameters/distribution and related information 1892 IF ( check_existence( var_names, 'soil_pars' ) ) THEN 1893 soil_pars_f%from_file = .TRUE. 1894 CALL get_attribute( id_surf, char_fill, & 1895 soil_pars_f%fill, & 1896 .FALSE., 'soil_pars' ) 1897 1898 CALL get_attribute( id_surf, char_lod, & 1899 soil_pars_f%lod, & 1900 .FALSE., 'soil_pars' ) 1901 1902 ! 1903 !-- Inquire number of soil parameters 1904 CALL get_dimension_length( id_surf, & 1905 soil_pars_f%np, & 1906 'nsoil_pars' ) 1907 ! 1908 !-- Read parameters array 1909 ALLOCATE( soil_pars_f%pars(0:soil_pars_f%np-1) ) 1910 CALL get_variable( id_surf, 'nsoil_pars', soil_pars_f%pars ) 1911 1912 ! 1913 !-- In case of level of detail 2, also inquire number of vertical 1914 !-- soil layers, allocate memory and read the respective dimension 1915 IF ( soil_pars_f%lod == 2 ) THEN 1916 CALL get_dimension_length( id_surf, & 1917 soil_pars_f%nz, & 1918 'zsoil' ) 1919 1920 ALLOCATE( soil_pars_f%layers(0:soil_pars_f%nz-1) ) 1921 CALL get_variable( id_surf, 'zsoil', soil_pars_f%layers ) 1922 1923 ENDIF 1924 1925 ! 1926 !-- Read soil parameters, depending on level of detail 1927 IF ( soil_pars_f%lod == 1 ) THEN 1928 ALLOCATE( soil_pars_f%pars_xy(0:soil_pars_f%np-1, & 1929 nys:nyn,nxl:nxr) ) 1930 1931 CALL get_variable( id_surf, 'soil_pars', soil_pars_f%pars_xy, & 1932 nxl, nxr, nys, nyn, 0, soil_pars_f%np-1 ) 1933 1934 ELSEIF ( soil_pars_f%lod == 2 ) THEN 1935 ALLOCATE( soil_pars_f%pars_xyz(0:soil_pars_f%np-1, & 1936 0:soil_pars_f%nz-1, & 1937 nys:nyn,nxl:nxr) ) 1938 CALL get_variable( id_surf, 'soil_pars', & 1939 soil_pars_f%pars_xyz, & 1940 nxl, nxr, nys, nyn, 0, soil_pars_f%nz-1, & 1941 0, soil_pars_f%np-1 ) 1942 1943 ENDIF 1944 ELSE 1945 soil_pars_f%from_file = .FALSE. 1946 ENDIF 1947 1948 ! 1949 !-- Read water parameters and related information 1950 IF ( check_existence( var_names, 'water_pars' ) ) THEN 1951 water_pars_f%from_file = .TRUE. 1952 CALL get_attribute( id_surf, char_fill, & 1953 water_pars_f%fill, & 1954 .FALSE., 'water_pars' ) 1955 ! 1956 !-- Inquire number of water parameters 1957 CALL get_dimension_length( id_surf, & 1958 water_pars_f%np, & 1959 'nwater_pars' ) 1960 ! 1961 !-- Allocate dimension array and input array for water parameters 1962 ALLOCATE( water_pars_f%pars(0:water_pars_f%np-1) ) 1963 ALLOCATE( water_pars_f%pars_xy(0:water_pars_f%np-1, & 1964 nys:nyn,nxl:nxr) ) 1965 ! 1966 !-- Get dimension of water parameters 1967 CALL get_variable( id_surf, 'nwater_pars', water_pars_f%pars ) 1968 1969 CALL get_variable( id_surf, 'water_pars', water_pars_f%pars_xy, & 1970 nxl, nxr, nys, nyn, 0, water_pars_f%np-1 ) 1971 ELSE 1972 water_pars_f%from_file = .FALSE. 1973 ENDIF 1974 ! 1975 !-- Read root area density - parametrized vegetation 1976 IF ( check_existence( var_names, 'root_area_dens_s' ) ) THEN 1977 root_area_density_lsm_f%from_file = .TRUE. 1978 CALL get_attribute( id_surf, char_fill, & 1979 root_area_density_lsm_f%fill, & 1980 .FALSE., 'root_area_dens_s' ) 1981 ! 1982 !-- Obtain number of soil layers from file and allocate variable 1983 CALL get_dimension_length( id_surf, & 1984 root_area_density_lsm_f%nz, & 1985 'zsoil' ) 1986 ALLOCATE( root_area_density_lsm_f%var & 1987 (0:root_area_density_lsm_f%nz-1, & 1988 nys:nyn,nxl:nxr) ) 1989 1990 ! 1991 !-- Read root-area density 1992 CALL get_variable( id_surf, 'root_area_dens_s', & 1993 root_area_density_lsm_f%var, & 1994 nxl, nxr, nys, nyn, & 1995 0, root_area_density_lsm_f%nz-1 ) 1996 1997 ELSE 1998 root_area_density_lsm_f%from_file = .FALSE. 1999 ENDIF 2000 ! 2001 !-- Read street type and street crossing 2002 IF ( check_existence( var_names, 'street_type' ) ) THEN 2003 street_type_f%from_file = .TRUE. 2004 CALL get_attribute( id_surf, char_fill, & 2005 street_type_f%fill, .FALSE., & 2006 'street_type' ) 2007 2008 ALLOCATE ( street_type_f%var(nys:nyn,nxl:nxr) ) 2009 2010 CALL get_variable( id_surf, 'street_type', street_type_f%var, & 2011 nxl, nxr, nys, nyn ) 2012 ELSE 2013 street_type_f%from_file = .FALSE. 2014 ENDIF 2015 2016 IF ( check_existence( var_names, 'street_crossing' ) ) THEN 2017 street_crossing_f%from_file = .TRUE. 2018 CALL get_attribute( id_surf, char_fill, & 2019 street_crossing_f%fill, .FALSE., & 2020 'street_crossing' ) 2021 2022 ALLOCATE ( street_crossing_f%var(nys:nyn,nxl:nxr) ) 2023 2024 CALL get_variable( id_surf, 'street_crossing', & 2025 street_crossing_f%var, nxl, nxr, nys, nyn ) 2026 2027 ELSE 2028 street_crossing_f%from_file = .FALSE. 2029 ENDIF 2030 ! 2031 !-- Still missing: root_resolved and building_surface_pars. 2032 !-- Will be implemented as soon as they are available. 2033 2034 ! 2035 !-- Finally, close input file 2036 CALL close_input_file( id_surf ) 1817 ELSE 1818 soil_pars_f%from_file = .FALSE. 1819 ENDIF 1820 1821 ! 1822 !-- Read water parameters and related information 1823 IF ( check_existence( var_names, 'water_pars' ) ) THEN 1824 water_pars_f%from_file = .TRUE. 1825 CALL get_attribute( id_surf, char_fill, water_pars_f%fill, .FALSE., 'water_pars' ) 1826 ! 1827 !-- Inquire number of water parameters 1828 CALL get_dimension_length( id_surf, water_pars_f%np, 'nwater_pars' ) 1829 ! 1830 !-- Allocate dimension array and input array for water parameters 1831 ALLOCATE( water_pars_f%pars(0:water_pars_f%np-1) ) 1832 ALLOCATE( water_pars_f%pars_xy(0:water_pars_f%np-1,nys:nyn,nxl:nxr) ) 1833 ! 1834 !-- Get dimension of water parameters 1835 CALL get_variable( id_surf, 'nwater_pars', water_pars_f%pars ) 1836 CALL get_variable( id_surf, 'water_pars', water_pars_f%pars_xy, & 1837 nxl, nxr, nys, nyn, 0, water_pars_f%np-1 ) 1838 ELSE 1839 water_pars_f%from_file = .FALSE. 1840 ENDIF 1841 ! 1842 !-- Read root area density - parametrized vegetation 1843 IF ( check_existence( var_names, 'root_area_dens_s' ) ) THEN 1844 root_area_density_lsm_f%from_file = .TRUE. 1845 CALL get_attribute( id_surf, char_fill, root_area_density_lsm_f%fill, .FALSE., & 1846 'root_area_dens_s' ) 1847 ! 1848 !-- Obtain number of soil layers from file and allocate variable 1849 CALL get_dimension_length( id_surf, root_area_density_lsm_f%nz, 'zsoil' ) 1850 ALLOCATE( root_area_density_lsm_f%var(0:root_area_density_lsm_f%nz-1,nys:nyn,nxl:nxr) ) 1851 1852 ! 1853 !-- Read root-area density 1854 CALL get_variable( id_surf, 'root_area_dens_s', root_area_density_lsm_f%var, & 1855 nxl, nxr, nys, nyn, 0, root_area_density_lsm_f%nz-1 ) 1856 1857 ELSE 1858 root_area_density_lsm_f%from_file = .FALSE. 1859 ENDIF 1860 ! 1861 !-- Read street type and street crossing 1862 IF ( check_existence( var_names, 'street_type' ) ) THEN 1863 street_type_f%from_file = .TRUE. 1864 CALL get_attribute( id_surf, char_fill, street_type_f%fill, .FALSE., 'street_type' ) 1865 ALLOCATE( street_type_f%var(nys:nyn,nxl:nxr) ) 1866 CALL get_variable( id_surf, 'street_type', street_type_f%var, nxl, nxr, nys, nyn ) 1867 ELSE 1868 street_type_f%from_file = .FALSE. 1869 ENDIF 1870 1871 IF ( check_existence( var_names, 'street_crossing' ) ) THEN 1872 street_crossing_f%from_file = .TRUE. 1873 CALL get_attribute( id_surf, char_fill, street_crossing_f%fill, .FALSE., 'street_crossing' ) 1874 ALLOCATE( street_crossing_f%var(nys:nyn,nxl:nxr) ) 1875 CALL get_variable( id_surf, 'street_crossing', street_crossing_f%var, nxl, nxr, nys, nyn ) 1876 ELSE 1877 street_crossing_f%from_file = .FALSE. 1878 ENDIF 1879 1880 ! 1881 !-- Still missing: root_resolved and building_surface_pars. 1882 !-- Will be implemented as soon as they are available. 1883 1884 ! 1885 !-- Finally, close input file 1886 CALL close_input_file( id_surf ) 2037 1887 #endif 2038 1888 ! 2039 !-- End of CPU measurement 2040 CALL cpu_log( log_point_s(82), 'NetCDF input', 'stop' ) 2041 ! 2042 !-- Exchange ghost points for surface variables. Therefore, resize 2043 !-- variables. 2044 IF ( albedo_type_f%from_file ) THEN 2045 CALL resize_array_2d_int8( albedo_type_f%var, nys, nyn, nxl, nxr ) 2046 CALL exchange_horiz_2d_byte( albedo_type_f%var, nys, nyn, nxl, nxr, & 2047 nbgp ) 2048 ENDIF 2049 IF ( pavement_type_f%from_file ) THEN 2050 CALL resize_array_2d_int8( pavement_type_f%var, nys, nyn, nxl, nxr ) 2051 CALL exchange_horiz_2d_byte( pavement_type_f%var, nys, nyn, nxl, nxr,& 2052 nbgp ) 2053 ENDIF 2054 IF ( soil_type_f%from_file .AND. ALLOCATED( soil_type_f%var_2d ) ) THEN 2055 CALL resize_array_2d_int8( soil_type_f%var_2d, nys, nyn, nxl, nxr ) 2056 CALL exchange_horiz_2d_byte( soil_type_f%var_2d, nys, nyn, nxl, nxr, & 2057 nbgp ) 2058 ENDIF 2059 IF ( vegetation_type_f%from_file ) THEN 2060 CALL resize_array_2d_int8( vegetation_type_f%var, nys, nyn, nxl, nxr ) 2061 CALL exchange_horiz_2d_byte( vegetation_type_f%var, nys, nyn, nxl, & 2062 nxr, nbgp ) 2063 ENDIF 2064 IF ( water_type_f%from_file ) THEN 2065 CALL resize_array_2d_int8( water_type_f%var, nys, nyn, nxl, nxr ) 2066 CALL exchange_horiz_2d_byte( water_type_f%var, nys, nyn, nxl, nxr, & 2067 nbgp ) 2068 ENDIF 2069 ! 2070 !-- Exchange ghost points for 3/4-D variables. For the sake of simplicity, 2071 !-- loop further dimensions to use 2D exchange routines. Unfortunately this 2072 !-- is necessary, else new MPI-data types need to be introduced just for 2073 !-- 2 variables. 2074 IF ( soil_type_f%from_file .AND. ALLOCATED( soil_type_f%var_3d ) ) & 2075 THEN 2076 CALL resize_array_3d_int8( soil_type_f%var_3d, 0, nz_soil, & 2077 nys, nyn, nxl, nxr ) 2078 DO k = 0, nz_soil 2079 CALL exchange_horiz_2d_byte( & 2080 soil_type_f%var_3d(k,:,:), nys, nyn, nxl, nxr, nbgp ) 1889 !-- End of CPU measurement 1890 CALL cpu_log( log_point_s(82), 'NetCDF input', 'stop' ) 1891 1892 ! 1893 !-- Exchange ghost points for surface variables. Therefore, resize variables. 1894 IF ( albedo_type_f%from_file ) THEN 1895 CALL resize_array_2d_int8( albedo_type_f%var, nys, nyn, nxl, nxr ) 1896 CALL exchange_horiz_2d_byte( albedo_type_f%var, nys, nyn, nxl, nxr, nbgp ) 1897 ENDIF 1898 IF ( pavement_type_f%from_file ) THEN 1899 CALL resize_array_2d_int8( pavement_type_f%var, nys, nyn, nxl, nxr ) 1900 CALL exchange_horiz_2d_byte( pavement_type_f%var, nys, nyn, nxl, nxr, nbgp ) 1901 ENDIF 1902 IF ( soil_type_f%from_file .AND. ALLOCATED( soil_type_f%var_2d ) ) THEN 1903 CALL resize_array_2d_int8( soil_type_f%var_2d, nys, nyn, nxl, nxr ) 1904 CALL exchange_horiz_2d_byte( soil_type_f%var_2d, nys, nyn, nxl, nxr, nbgp ) 1905 ENDIF 1906 IF ( vegetation_type_f%from_file ) THEN 1907 CALL resize_array_2d_int8( vegetation_type_f%var, nys, nyn, nxl, nxr ) 1908 CALL exchange_horiz_2d_byte( vegetation_type_f%var, nys, nyn, nxl, nxr, nbgp ) 1909 ENDIF 1910 IF ( water_type_f%from_file ) THEN 1911 CALL resize_array_2d_int8( water_type_f%var, nys, nyn, nxl, nxr ) 1912 CALL exchange_horiz_2d_byte( water_type_f%var, nys, nyn, nxl, nxr, nbgp ) 1913 ENDIF 1914 1915 ! 1916 !-- Exchange ghost points for 3/4-D variables. For the sake of simplicity, loop further dimensions 1917 !-- to use 2D exchange routines. Unfortunately this is necessary, else new MPI-data types need to be 1918 !-- introduced just for 2 variables. 1919 IF ( soil_type_f%from_file .AND. ALLOCATED( soil_type_f%var_3d ) ) THEN 1920 CALL resize_array_3d_int8( soil_type_f%var_3d, 0, nz_soil, nys, nyn, nxl, nxr ) 1921 DO k = 0, nz_soil 1922 CALL exchange_horiz_2d_byte( soil_type_f%var_3d(k,:,:), nys, nyn, nxl, nxr, nbgp ) 1923 ENDDO 1924 ENDIF 1925 1926 IF ( surface_fraction_f%from_file ) THEN 1927 CALL resize_array_3d_real( surface_fraction_f%frac, 0, surface_fraction_f%nf-1, nys, nyn, & 1928 nxl, nxr ) 1929 DO k = 0, surface_fraction_f%nf-1 1930 CALL exchange_horiz_2d( surface_fraction_f%frac(k,:,:) ) 1931 ENDDO 1932 ENDIF 1933 1934 IF ( building_pars_f%from_file ) THEN 1935 CALL resize_array_3d_real( building_pars_f%pars_xy, 0, building_pars_f%np-1, nys, nyn, nxl, & 1936 nxr ) 1937 DO k = 0, building_pars_f%np-1 1938 CALL exchange_horiz_2d( building_pars_f%pars_xy(k,:,:) ) 1939 ENDDO 1940 ENDIF 1941 1942 IF ( albedo_pars_f%from_file ) THEN 1943 CALL resize_array_3d_real( albedo_pars_f%pars_xy, 0, albedo_pars_f%np-1, nys, nyn, nxl, nxr ) 1944 DO k = 0, albedo_pars_f%np-1 1945 CALL exchange_horiz_2d( albedo_pars_f%pars_xy(k,:,:) ) 1946 ENDDO 1947 ENDIF 1948 1949 IF ( pavement_pars_f%from_file ) THEN 1950 CALL resize_array_3d_real( pavement_pars_f%pars_xy, 0, pavement_pars_f%np-1, nys, nyn, nxl, & 1951 nxr ) 1952 DO k = 0, pavement_pars_f%np-1 1953 CALL exchange_horiz_2d( pavement_pars_f%pars_xy(k,:,:) ) 1954 ENDDO 1955 ENDIF 1956 1957 IF ( vegetation_pars_f%from_file ) THEN 1958 CALL resize_array_3d_real( vegetation_pars_f%pars_xy, 0, vegetation_pars_f%np-1, nys, nyn, & 1959 nxl, nxr ) 1960 DO k = 0, vegetation_pars_f%np-1 1961 CALL exchange_horiz_2d( vegetation_pars_f%pars_xy(k,:,:) ) 1962 ENDDO 1963 ENDIF 1964 1965 IF ( water_pars_f%from_file ) THEN 1966 CALL resize_array_3d_real( water_pars_f%pars_xy, 0, water_pars_f%np-1, nys, nyn, nxl, nxr ) 1967 DO k = 0, water_pars_f%np-1 1968 CALL exchange_horiz_2d( water_pars_f%pars_xy(k,:,:) ) 1969 ENDDO 1970 ENDIF 1971 1972 IF ( root_area_density_lsm_f%from_file ) THEN 1973 CALL resize_array_3d_real( root_area_density_lsm_f%var, 0, root_area_density_lsm_f%nz-1, & 1974 nys, nyn, nxl, nxr ) 1975 DO k = 0, root_area_density_lsm_f%nz-1 1976 CALL exchange_horiz_2d( root_area_density_lsm_f%var(k,:,:) ) 1977 ENDDO 1978 ENDIF 1979 1980 IF ( soil_pars_f%from_file ) THEN 1981 IF ( soil_pars_f%lod == 1 ) THEN 1982 CALL resize_array_3d_real( soil_pars_f%pars_xy, 0, soil_pars_f%np-1, nys, nyn, nxl, nxr ) 1983 DO k = 0, soil_pars_f%np-1 1984 CALL exchange_horiz_2d( soil_pars_f%pars_xy(k,:,:) ) 2081 1985 ENDDO 2082 ENDIF 2083 2084 IF ( surface_fraction_f%from_file ) THEN 2085 CALL resize_array_3d_real( surface_fraction_f%frac, & 2086 0, surface_fraction_f%nf-1, & 2087 nys, nyn, nxl, nxr ) 2088 DO k = 0, surface_fraction_f%nf-1 2089 CALL exchange_horiz_2d( surface_fraction_f%frac(k,:,:) ) 2090 ENDDO 2091 ENDIF 2092 2093 IF ( building_pars_f%from_file ) THEN 2094 CALL resize_array_3d_real( building_pars_f%pars_xy, & 2095 0, building_pars_f%np-1, & 2096 nys, nyn, nxl, nxr ) 2097 DO k = 0, building_pars_f%np-1 2098 CALL exchange_horiz_2d( building_pars_f%pars_xy(k,:,:) ) 2099 ENDDO 2100 ENDIF 2101 2102 IF ( albedo_pars_f%from_file ) THEN 2103 CALL resize_array_3d_real( albedo_pars_f%pars_xy, & 2104 0, albedo_pars_f%np-1, & 2105 nys, nyn, nxl, nxr ) 2106 DO k = 0, albedo_pars_f%np-1 2107 CALL exchange_horiz_2d( albedo_pars_f%pars_xy(k,:,:) ) 2108 ENDDO 2109 ENDIF 2110 2111 IF ( pavement_pars_f%from_file ) THEN 2112 CALL resize_array_3d_real( pavement_pars_f%pars_xy, & 2113 0, pavement_pars_f%np-1, & 2114 nys, nyn, nxl, nxr ) 2115 DO k = 0, pavement_pars_f%np-1 2116 CALL exchange_horiz_2d( pavement_pars_f%pars_xy(k,:,:) ) 2117 ENDDO 2118 ENDIF 2119 2120 IF ( vegetation_pars_f%from_file ) THEN 2121 CALL resize_array_3d_real( vegetation_pars_f%pars_xy, & 2122 0, vegetation_pars_f%np-1, & 2123 nys, nyn, nxl, nxr ) 2124 DO k = 0, vegetation_pars_f%np-1 2125 CALL exchange_horiz_2d( vegetation_pars_f%pars_xy(k,:,:) ) 2126 ENDDO 2127 ENDIF 2128 2129 IF ( water_pars_f%from_file ) THEN 2130 CALL resize_array_3d_real( water_pars_f%pars_xy, & 2131 0, water_pars_f%np-1, & 2132 nys, nyn, nxl, nxr ) 2133 DO k = 0, water_pars_f%np-1 2134 CALL exchange_horiz_2d( water_pars_f%pars_xy(k,:,:) ) 2135 ENDDO 2136 ENDIF 2137 2138 IF ( root_area_density_lsm_f%from_file ) THEN 2139 CALL resize_array_3d_real( root_area_density_lsm_f%var, & 2140 0, root_area_density_lsm_f%nz-1, & 2141 nys, nyn, nxl, nxr ) 2142 DO k = 0, root_area_density_lsm_f%nz-1 2143 CALL exchange_horiz_2d( root_area_density_lsm_f%var(k,:,:) ) 2144 ENDDO 2145 ENDIF 2146 2147 IF ( soil_pars_f%from_file ) THEN 2148 IF ( soil_pars_f%lod == 1 ) THEN 2149 2150 CALL resize_array_3d_real( soil_pars_f%pars_xy, & 2151 0, soil_pars_f%np-1, & 2152 nys, nyn, nxl, nxr ) 1986 1987 ELSEIF ( soil_pars_f%lod == 2 ) THEN 1988 CALL resize_array_4d_real( soil_pars_f%pars_xyz, 0, soil_pars_f%np-1, & 1989 0, soil_pars_f%nz-1, nys, nyn, nxl, nxr ) 1990 1991 DO k2 = 0, soil_pars_f%nz-1 2153 1992 DO k = 0, soil_pars_f%np-1 2154 CALL exchange_horiz_2d( soil_pars_f%pars_xy(k,:,:) ) 2155 ENDDO 2156 2157 ELSEIF ( soil_pars_f%lod == 2 ) THEN 2158 CALL resize_array_4d_real( soil_pars_f%pars_xyz, & 2159 0, soil_pars_f%np-1, & 2160 0, soil_pars_f%nz-1, & 2161 nys, nyn, nxl, nxr ) 2162 2163 DO k2 = 0, soil_pars_f%nz-1 2164 DO k = 0, soil_pars_f%np-1 2165 CALL exchange_horiz_2d( soil_pars_f%pars_xyz(k,k2,:,:) ) 2166 ENDDO 2167 ENDDO 2168 ENDIF 2169 ENDIF 2170 2171 IF ( pavement_subsurface_pars_f%from_file ) THEN 2172 CALL resize_array_4d_real( pavement_subsurface_pars_f%pars_xyz, & 2173 0, pavement_subsurface_pars_f%np-1, & 2174 0, pavement_subsurface_pars_f%nz-1, & 2175 nys, nyn, nxl, nxr ) 2176 2177 DO k2 = 0, pavement_subsurface_pars_f%nz-1 2178 DO k = 0, pavement_subsurface_pars_f%np-1 2179 CALL exchange_horiz_2d( & 2180 pavement_subsurface_pars_f%pars_xyz(k,k2,:,:) ) 1993 CALL exchange_horiz_2d( soil_pars_f%pars_xyz(k,k2,:,:) ) 2181 1994 ENDDO 2182 1995 ENDDO 2183 1996 ENDIF 2184 2185 END SUBROUTINE netcdf_data_input_surface_data 2186 2187 !------------------------------------------------------------------------------! 1997 ENDIF 1998 1999 IF ( pavement_subsurface_pars_f%from_file ) THEN 2000 CALL resize_array_4d_real( pavement_subsurface_pars_f%pars_xyz, & 2001 0, pavement_subsurface_pars_f%np-1, & 2002 0, pavement_subsurface_pars_f%nz-1, nys, nyn, nxl, nxr ) 2003 2004 DO k2 = 0, pavement_subsurface_pars_f%nz-1 2005 DO k = 0, pavement_subsurface_pars_f%np-1 2006 CALL exchange_horiz_2d( pavement_subsurface_pars_f%pars_xyz(k,k2,:,:) ) 2007 ENDDO 2008 ENDDO 2009 ENDIF 2010 2011 END SUBROUTINE netcdf_data_input_surface_data 2012 2013 2014 !--------------------------------------------------------------------------------------------------! 2188 2015 ! Description: 2189 2016 ! ------------ 2190 2017 !> Reads uvem lookup table information. 2191 !------------------------------------------------------------------------------ !2192 2193 2194 USE indices,&2195 2196 2197 2198 2199 2200 2201 2202 2203 2204 2205 2206 2207 ! 2208 !-- 2209 2018 !--------------------------------------------------------------------------------------------------! 2019 SUBROUTINE netcdf_data_input_uvem 2020 2021 USE indices, & 2022 ONLY: nxl, nxr, nyn, nys 2023 2024 IMPLICIT NONE 2025 2026 CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names in static input file 2027 2028 2029 INTEGER(iwp) :: id_uvem !< NetCDF id of uvem lookup table input file 2030 INTEGER(iwp) :: nli = 35 !< dimension length of lookup table in x 2031 INTEGER(iwp) :: nlj = 9 !< dimension length of lookup table in y 2032 INTEGER(iwp) :: nlk = 90 !< dimension length of lookup table in z 2033 INTEGER(iwp) :: num_vars !< number of variables in netcdf input file 2034 ! 2035 !-- Input via uv exposure model lookup table input 2036 IF ( input_pids_uvem ) THEN 2210 2037 2211 2038 #if defined ( __netcdf ) 2212 2039 ! 2213 !-- Open file in read-only mode 2214 CALL open_read_file( TRIM( input_file_uvem ) // & 2215 TRIM( coupling_char ), id_uvem ) 2216 ! 2217 !-- At first, inquire all variable names. 2218 !-- This will be used to check whether an input variable exist or not. 2219 CALL inquire_num_variables( id_uvem, num_vars ) 2220 ! 2221 !-- Allocate memory to store variable names and inquire them. 2222 ALLOCATE( var_names(1:num_vars) ) 2223 CALL inquire_variable_names( id_uvem, var_names ) 2224 ! 2225 !-- uvem integration 2226 IF ( check_existence( var_names, 'int_factors' ) ) THEN 2227 uvem_integration_f%from_file = .TRUE. 2228 ! 2229 !-- Input 2D uvem integration. 2230 ALLOCATE ( uvem_integration_f%var(0:nlj,0:nli) ) 2231 2232 CALL get_variable( id_uvem, 'int_factors', uvem_integration_f%var, 0, nli, 0, nlj ) 2233 ELSE 2234 uvem_integration_f%from_file = .FALSE. 2235 ENDIF 2236 ! 2237 !-- uvem irradiance 2238 IF ( check_existence( var_names, 'irradiance' ) ) THEN 2239 uvem_irradiance_f%from_file = .TRUE. 2240 ! 2241 !-- Input 2D uvem irradiance. 2242 ALLOCATE ( uvem_irradiance_f%var(0:nlk, 0:2) ) 2243 2244 CALL get_variable( id_uvem, 'irradiance', uvem_irradiance_f%var, 0, 2, 0, nlk ) 2245 ELSE 2246 uvem_irradiance_f%from_file = .FALSE. 2247 ENDIF 2248 ! 2249 !-- uvem porjection areas 2250 IF ( check_existence( var_names, 'projarea' ) ) THEN 2251 uvem_projarea_f%from_file = .TRUE. 2252 ! 2253 !-- Input 3D uvem projection area (human geometgry) 2254 ALLOCATE ( uvem_projarea_f%var(0:2,0:nlj,0:nli) ) 2255 2256 CALL get_variable( id_uvem, 'projarea', uvem_projarea_f%var, 0, nli, 0, nlj, 0, 2 ) 2257 ELSE 2258 uvem_projarea_f%from_file = .FALSE. 2259 ENDIF 2260 ! 2261 !-- uvem radiance 2262 IF ( check_existence( var_names, 'radiance' ) ) THEN 2263 uvem_radiance_f%from_file = .TRUE. 2264 ! 2265 !-- Input 3D uvem radiance 2266 ALLOCATE ( uvem_radiance_f%var(0:nlk,0:nlj,0:nli) ) 2267 2268 CALL get_variable( id_uvem, 'radiance', uvem_radiance_f%var, 0, nli, 0, nlj, 0, nlk ) 2269 ELSE 2270 uvem_radiance_f%from_file = .FALSE. 2271 ENDIF 2272 ! 2273 !-- Read building obstruction 2274 IF ( check_existence( var_names, 'obstruction' ) ) THEN 2275 building_obstruction_full%from_file = .TRUE. 2276 !-- Input 3D uvem building obstruction 2277 ALLOCATE ( building_obstruction_full%var_3d(0:44,0:2,0:2) ) 2278 CALL get_variable( id_uvem, 'obstruction', building_obstruction_full%var_3d,0, 2, 0, 2, 0, 44 ) 2279 ELSE 2280 building_obstruction_full%from_file = .FALSE. 2281 ENDIF 2282 ! 2283 IF ( check_existence( var_names, 'obstruction' ) ) THEN 2284 building_obstruction_f%from_file = .TRUE. 2285 ! 2286 !-- Input 3D uvem building obstruction 2287 ALLOCATE ( building_obstruction_f%var_3d(0:44,nys:nyn,nxl:nxr) ) 2288 ! 2289 CALL get_variable( id_uvem, 'obstruction', building_obstruction_f%var_3d, & 2290 nxl, nxr, nys, nyn, 0, 44 ) 2291 ELSE 2292 building_obstruction_f%from_file = .FALSE. 2293 ENDIF 2294 ! 2295 !-- Close uvem lookup table input file 2296 CALL close_input_file( id_uvem ) 2040 !-- Open file in read-only mode 2041 CALL open_read_file( TRIM( input_file_uvem ) // TRIM( coupling_char ), id_uvem ) 2042 ! 2043 !-- At first, inquire all variable names. 2044 !-- This will be used to check whether an input variable exist or not. 2045 CALL inquire_num_variables( id_uvem, num_vars ) 2046 ! 2047 !-- Allocate memory to store variable names and inquire them. 2048 ALLOCATE( var_names(1:num_vars) ) 2049 CALL inquire_variable_names( id_uvem, var_names ) 2050 ! 2051 !-- uvem integration 2052 IF ( check_existence( var_names, 'int_factors' ) ) THEN 2053 uvem_integration_f%from_file = .TRUE. 2054 ! 2055 !-- Input 2D uvem integration. 2056 ALLOCATE( uvem_integration_f%var(0:nlj,0:nli) ) 2057 CALL get_variable( id_uvem, 'int_factors', uvem_integration_f%var, 0, nli, 0, nlj ) 2058 ELSE 2059 uvem_integration_f%from_file = .FALSE. 2060 ENDIF 2061 ! 2062 !-- uvem irradiance 2063 IF ( check_existence( var_names, 'irradiance' ) ) THEN 2064 uvem_irradiance_f%from_file = .TRUE. 2065 ! 2066 !-- Input 2D uvem irradiance. 2067 ALLOCATE( uvem_irradiance_f%var(0:nlk, 0:2) ) 2068 CALL get_variable( id_uvem, 'irradiance', uvem_irradiance_f%var, 0, 2, 0, nlk ) 2069 ELSE 2070 uvem_irradiance_f%from_file = .FALSE. 2071 ENDIF 2072 ! 2073 !-- uvem porjection areas 2074 IF ( check_existence( var_names, 'projarea' ) ) THEN 2075 uvem_projarea_f%from_file = .TRUE. 2076 ! 2077 !-- Input 3D uvem projection area (human geometgry) 2078 ALLOCATE( uvem_projarea_f%var(0:2,0:nlj,0:nli) ) 2079 CALL get_variable( id_uvem, 'projarea', uvem_projarea_f%var, 0, nli, 0, nlj, 0, 2 ) 2080 ELSE 2081 uvem_projarea_f%from_file = .FALSE. 2082 ENDIF 2083 ! 2084 !-- uvem radiance 2085 IF ( check_existence( var_names, 'radiance' ) ) THEN 2086 uvem_radiance_f%from_file = .TRUE. 2087 ! 2088 !-- Input 3D uvem radiance 2089 ALLOCATE( uvem_radiance_f%var(0:nlk,0:nlj,0:nli) ) 2090 CALL get_variable( id_uvem, 'radiance', uvem_radiance_f%var, 0, nli, 0, nlj, 0, nlk ) 2091 ELSE 2092 uvem_radiance_f%from_file = .FALSE. 2093 ENDIF 2094 ! 2095 !-- Read building obstruction 2096 IF ( check_existence( var_names, 'obstruction' ) ) THEN 2097 building_obstruction_full%from_file = .TRUE. 2098 ! 2099 !-- Input 3D uvem building obstruction 2100 ALLOCATE( building_obstruction_full%var_3d(0:44,0:2,0:2) ) 2101 CALL get_variable( id_uvem, 'obstruction', building_obstruction_full%var_3d, 0, 2, 0, 2, & 2102 0, 44 ) 2103 ELSE 2104 building_obstruction_full%from_file = .FALSE. 2105 ENDIF 2106 ! 2107 IF ( check_existence( var_names, 'obstruction' ) ) THEN 2108 building_obstruction_f%from_file = .TRUE. 2109 ! 2110 !-- Input 3D uvem building obstruction 2111 ALLOCATE( building_obstruction_f%var_3d(0:44,nys:nyn,nxl:nxr) ) 2112 CALL get_variable( id_uvem, 'obstruction', building_obstruction_f%var_3d, & 2113 nxl, nxr, nys, nyn, 0, 44 ) 2114 ELSE 2115 building_obstruction_f%from_file = .FALSE. 2116 ENDIF 2117 ! 2118 !-- Close uvem lookup table input file 2119 CALL close_input_file( id_uvem ) 2297 2120 #else 2298 2121 CONTINUE 2299 2122 #endif 2300 ENDIF 2301 END SUBROUTINE netcdf_data_input_uvem 2302 2303 !------------------------------------------------------------------------------! 2123 ENDIF 2124 2125 END SUBROUTINE netcdf_data_input_uvem 2126 2127 2128 !--------------------------------------------------------------------------------------------------! 2304 2129 ! Description: 2305 2130 ! ------------ 2306 2131 !> Reads orography and building information. 2307 !------------------------------------------------------------------------------! 2308 SUBROUTINE netcdf_data_input_topo 2309 2310 USE control_parameters, & 2311 ONLY: message_string, topography 2312 2313 USE exchange_horiz_mod, & 2314 ONLY: exchange_horiz_2d_byte, exchange_horiz_2d_int 2315 2316 USE grid_variables, & 2317 ONLY: dx, dy 2318 2319 USE indices, & 2320 ONLY: nbgp, nx, nxl, nxr, ny, nyn, nys, nzb 2321 2322 2323 IMPLICIT NONE 2324 2325 CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names in static input file 2326 2327 2328 INTEGER(iwp) :: i !< running index along x-direction 2329 INTEGER(iwp) :: ii !< running index for IO blocks 2330 INTEGER(iwp) :: id_topo !< NetCDF id of topograhy input file 2331 INTEGER(iwp) :: io_status !< status after reading the ascii topo file 2332 INTEGER(iwp) :: j !< running index along y-direction 2333 INTEGER(iwp) :: num_vars !< number of variables in netcdf input file 2334 INTEGER(iwp) :: skip_n_rows !< counting variable to skip rows while reading topography file 2335 2336 REAL(wp) :: dum !< dummy variable to skip columns while reading topography file 2337 ! 2338 !-- CPU measurement 2339 CALL cpu_log( log_point_s(83), 'NetCDF/ASCII input topo', 'start' ) 2340 2341 ! 2342 !-- Input via palm-input data standard 2343 IF ( input_pids_static ) THEN 2132 !--------------------------------------------------------------------------------------------------! 2133 SUBROUTINE netcdf_data_input_topo 2134 2135 USE control_parameters, & 2136 ONLY: message_string, topography 2137 2138 USE exchange_horiz_mod, & 2139 ONLY: exchange_horiz_2d_byte, exchange_horiz_2d_int 2140 2141 USE grid_variables, & 2142 ONLY: dx, dy 2143 2144 USE indices, & 2145 ONLY: nbgp, nx, nxl, nxr, ny, nyn, nys, nzb 2146 2147 2148 IMPLICIT NONE 2149 2150 CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names !< variable names in static input file 2151 2152 2153 INTEGER(iwp) :: i !< running index along x-direction 2154 INTEGER(iwp) :: id_topo !< NetCDF id of topograhy input file 2155 INTEGER(iwp) :: ii !< running index for IO blocks 2156 INTEGER(iwp) :: io_status !< status after reading the ascii topo file 2157 INTEGER(iwp) :: j !< running index along y-direction 2158 INTEGER(iwp) :: num_vars !< number of variables in netcdf input file 2159 INTEGER(iwp) :: skip_n_rows !< counting variable to skip rows while reading topography file 2160 2161 REAL(wp) :: dum !< dummy variable to skip columns while reading topography file 2162 2163 2164 ! 2165 !-- CPU measurement 2166 CALL cpu_log( log_point_s(83), 'NetCDF/ASCII input topo', 'start' ) 2167 ! 2168 !-- Input via palm-input data standard 2169 IF ( input_pids_static ) THEN 2344 2170 #if defined ( __netcdf ) 2345 2171 ! 2346 !-- Open file in read-only mode 2347 CALL open_read_file( TRIM( input_file_static ) // & 2348 TRIM( coupling_char ), id_topo ) 2349 ! 2350 !-- At first, inquire all variable names. 2351 !-- This will be used to check whether an input variable exist 2352 !-- or not. 2353 CALL inquire_num_variables( id_topo, num_vars ) 2354 ! 2355 !-- Allocate memory to store variable names and inquire them. 2356 ALLOCATE( var_names(1:num_vars) ) 2357 CALL inquire_variable_names( id_topo, var_names ) 2358 ! 2359 !-- Read x, y - dimensions. Only required for consistency checks. 2360 CALL get_dimension_length( id_topo, dim_static%nx, 'x' ) 2361 CALL get_dimension_length( id_topo, dim_static%ny, 'y' ) 2362 ALLOCATE( dim_static%x(0:dim_static%nx-1) ) 2363 ALLOCATE( dim_static%y(0:dim_static%ny-1) ) 2364 CALL get_variable( id_topo, 'x', dim_static%x ) 2365 CALL get_variable( id_topo, 'y', dim_static%y ) 2366 ! 2367 !-- Check whether dimension size in input file matches the model dimensions 2368 IF ( dim_static%nx-1 /= nx .OR. dim_static%ny-1 /= ny ) THEN 2369 message_string = 'Static input file: horizontal dimension in ' // & 2370 'x- and/or y-direction ' // & 2371 'do not match the respective model dimension' 2372 CALL message( 'netcdf_data_input_mod', 'PA0548', 1, 2, 0, 6, 0 ) 2373 ENDIF 2374 ! 2375 !-- Check if grid spacing of provided input data matches the respective 2376 !-- grid spacing in the model. 2377 IF ( ABS( dim_static%x(1) - dim_static%x(0) - dx ) > 10E-6_wp .OR. & 2378 ABS( dim_static%y(1) - dim_static%y(0) - dy ) > 10E-6_wp ) THEN 2379 message_string = 'Static input file: horizontal grid spacing ' // & 2380 'in x- and/or y-direction ' // & 2381 'do not match the respective model grid spacing.' 2382 CALL message( 'netcdf_data_input_mod', 'PA0549', 1, 2, 0, 6, 0 ) 2383 ENDIF 2384 ! 2385 !-- Terrain height. First, get variable-related _FillValue attribute 2386 IF ( check_existence( var_names, 'zt' ) ) THEN 2387 terrain_height_f%from_file = .TRUE. 2388 CALL get_attribute( id_topo, char_fill, terrain_height_f%fill, & 2389 .FALSE., 'zt' ) 2390 ! 2391 !-- Input 2D terrain height. 2392 ALLOCATE ( terrain_height_f%var(nys:nyn,nxl:nxr) ) 2393 2394 CALL get_variable( id_topo, 'zt', terrain_height_f%var, & 2395 nxl, nxr, nys, nyn ) 2396 2397 ELSE 2398 terrain_height_f%from_file = .FALSE. 2399 ENDIF 2400 2401 ! 2402 !-- Read building height. First, read its _FillValue attribute, 2403 !-- as well as lod attribute 2404 buildings_f%from_file = .FALSE. 2405 IF ( check_existence( var_names, 'buildings_2d' ) ) THEN 2406 buildings_f%from_file = .TRUE. 2407 CALL get_attribute( id_topo, char_lod, buildings_f%lod, & 2408 .FALSE., 'buildings_2d' ) 2409 2410 CALL get_attribute( id_topo, char_fill, buildings_f%fill1, & 2411 .FALSE., 'buildings_2d' ) 2412 2413 ! 2414 !-- Read 2D buildings 2415 IF ( buildings_f%lod == 1 ) THEN 2416 ALLOCATE ( buildings_f%var_2d(nys:nyn,nxl:nxr) ) 2417 2418 CALL get_variable( id_topo, 'buildings_2d', & 2419 buildings_f%var_2d, & 2420 nxl, nxr, nys, nyn ) 2421 ELSE 2422 message_string = 'NetCDF attribute lod ' // & 2423 '(level of detail) is not set ' // & 2424 'properly for buildings_2d.' 2425 CALL message( 'netcdf_data_input_mod', 'PA0540', & 2426 1, 2, 0, 6, 0 ) 2427 ENDIF 2428 ENDIF 2429 ! 2430 !-- If available, also read 3D building information. If both are 2431 !-- available, use 3D information. 2432 IF ( check_existence( var_names, 'buildings_3d' ) ) THEN 2433 buildings_f%from_file = .TRUE. 2434 CALL get_attribute( id_topo, char_lod, buildings_f%lod, & 2435 .FALSE., 'buildings_3d' ) 2436 2437 CALL get_attribute( id_topo, char_fill, buildings_f%fill2, & 2438 .FALSE., 'buildings_3d' ) 2439 2440 CALL get_dimension_length( id_topo, buildings_f%nz, 'z' ) 2441 ! 2442 !-- Read 3D buildings 2443 IF ( buildings_f%lod == 2 ) THEN 2444 ALLOCATE( buildings_f%z(nzb:buildings_f%nz-1) ) 2445 CALL get_variable( id_topo, 'z', buildings_f%z ) 2446 2447 ALLOCATE( buildings_f%var_3d(nzb:buildings_f%nz-1, & 2448 nys:nyn,nxl:nxr) ) 2449 buildings_f%var_3d = 0 2450 2451 CALL get_variable( id_topo, 'buildings_3d', & 2452 buildings_f%var_3d, & 2453 nxl, nxr, nys, nyn, 0, buildings_f%nz-1 ) 2454 ELSE 2455 message_string = 'NetCDF attribute lod ' // & 2456 '(level of detail) is not set ' // & 2457 'properly for buildings_3d.' 2458 CALL message( 'netcdf_data_input_mod', 'PA0541', & 2459 1, 2, 0, 6, 0 ) 2460 ENDIF 2461 ENDIF 2462 ! 2463 !-- Read building IDs and its FillValue attribute. Further required 2464 !-- for mapping buildings on top of orography. 2465 IF ( check_existence( var_names, 'building_id' ) ) THEN 2466 building_id_f%from_file = .TRUE. 2467 CALL get_attribute( id_topo, char_fill, & 2468 building_id_f%fill, .FALSE., & 2469 'building_id' ) 2470 2471 ALLOCATE ( building_id_f%var(nys:nyn,nxl:nxr) ) 2472 2473 CALL get_variable( id_topo, 'building_id', building_id_f%var, & 2172 !-- Open file in read-only mode 2173 CALL open_read_file( TRIM( input_file_static ) // TRIM( coupling_char ), id_topo ) 2174 ! 2175 !-- At first, inquire all variable names. 2176 !-- This will be used to check whether an input variable exists or not. 2177 CALL inquire_num_variables( id_topo, num_vars ) 2178 ! 2179 !-- Allocate memory to store variable names and inquire them. 2180 ALLOCATE( var_names(1:num_vars) ) 2181 CALL inquire_variable_names( id_topo, var_names ) 2182 ! 2183 !-- Read x, y - dimensions. Only required for consistency checks. 2184 CALL get_dimension_length( id_topo, dim_static%nx, 'x' ) 2185 CALL get_dimension_length( id_topo, dim_static%ny, 'y' ) 2186 ALLOCATE( dim_static%x(0:dim_static%nx-1) ) 2187 ALLOCATE( dim_static%y(0:dim_static%ny-1) ) 2188 CALL get_variable( id_topo, 'x', dim_static%x ) 2189 CALL get_variable( id_topo, 'y', dim_static%y ) 2190 ! 2191 !-- Check whether dimension size in input file matches the model dimensions 2192 IF ( dim_static%nx-1 /= nx .OR. dim_static%ny-1 /= ny ) THEN 2193 message_string = 'Static input file: horizontal dimension in ' // & 2194 'x- and/or y-direction ' // & 2195 'do not match the respective model dimension' 2196 CALL message( 'netcdf_data_input_mod', 'PA0548', 1, 2, 0, 6, 0 ) 2197 ENDIF 2198 ! 2199 !-- Check if grid spacing of provided input data matches the respective grid spacing in the 2200 !-- model. 2201 IF ( ABS( dim_static%x(1) - dim_static%x(0) - dx ) > 10E-6_wp .OR. & 2202 ABS( dim_static%y(1) - dim_static%y(0) - dy ) > 10E-6_wp ) THEN 2203 message_string = 'Static input file: horizontal grid spacing ' // & 2204 'in x- and/or y-direction ' // & 2205 'do not match the respective model grid spacing.' 2206 CALL message( 'netcdf_data_input_mod', 'PA0549', 1, 2, 0, 6, 0 ) 2207 ENDIF 2208 ! 2209 !-- Terrain height. First, get variable-related _FillValue attribute 2210 IF ( check_existence( var_names, 'zt' ) ) THEN 2211 terrain_height_f%from_file = .TRUE. 2212 CALL get_attribute( id_topo, char_fill, terrain_height_f%fill, .FALSE., 'zt' ) 2213 ! 2214 !-- Input 2D terrain height. 2215 ALLOCATE( terrain_height_f%var(nys:nyn,nxl:nxr) ) 2216 2217 CALL get_variable( id_topo, 'zt', terrain_height_f%var, nxl, nxr, nys, nyn ) 2218 2219 ELSE 2220 terrain_height_f%from_file = .FALSE. 2221 ENDIF 2222 2223 ! 2224 !-- Read building height. First, read its _FillValue attribute, as well as lod attribute 2225 buildings_f%from_file = .FALSE. 2226 IF ( check_existence( var_names, 'buildings_2d' ) ) THEN 2227 buildings_f%from_file = .TRUE. 2228 CALL get_attribute( id_topo, char_lod, buildings_f%lod, .FALSE., 'buildings_2d' ) 2229 CALL get_attribute( id_topo, char_fill, buildings_f%fill1, .FALSE., 'buildings_2d' ) 2230 2231 ! 2232 !-- Read 2D buildings 2233 IF ( buildings_f%lod == 1 ) THEN 2234 ALLOCATE( buildings_f%var_2d(nys:nyn,nxl:nxr) ) 2235 CALL get_variable( id_topo, 'buildings_2d', & 2236 buildings_f%var_2d, & 2474 2237 nxl, nxr, nys, nyn ) 2475 2238 ELSE 2476 building_id_f%from_file = .FALSE. 2477 ENDIF 2478 ! 2479 !-- Read building_type and required attributes. 2480 IF ( check_existence( var_names, 'building_type' ) ) THEN 2481 building_type_f%from_file = .TRUE. 2482 CALL get_attribute( id_topo, char_fill, & 2483 building_type_f%fill, .FALSE., & 2484 'building_type' ) 2485 2486 ALLOCATE ( building_type_f%var(nys:nyn,nxl:nxr) ) 2487 2488 CALL get_variable( id_topo, 'building_type', building_type_f%var, & 2489 nxl, nxr, nys, nyn ) 2490 2491 ELSE 2492 building_type_f%from_file = .FALSE. 2493 ENDIF 2494 ! 2495 !-- Close topography input file 2496 CALL close_input_file( id_topo ) 2497 #else 2498 CONTINUE 2499 #endif 2500 ! 2501 !-- ASCII input 2502 ELSEIF ( TRIM( topography ) == 'read_from_file' ) THEN 2503 2504 DO ii = 0, io_blocks-1 2505 IF ( ii == io_group ) THEN 2506 2507 OPEN( 90, FILE='TOPOGRAPHY_DATA'//TRIM( coupling_char ), & 2508 STATUS='OLD', FORM='FORMATTED', IOSTAT=io_status ) 2509 2510 IF ( io_status > 0 ) THEN 2511 message_string = 'file TOPOGRAPHY_DATA'// & 2512 TRIM( coupling_char )// ' does not exist' 2513 CALL message( 'netcdf_data_input_mod', 'PA0208', 1, 2, 0, 6, 0 ) 2514 ENDIF 2515 2516 ! 2517 !-- Read topography PE-wise. Rows are read from nyn to nys, columns 2518 !-- are read from nxl to nxr. At first, ny-nyn rows need to be skipped. 2519 skip_n_rows = 0 2520 DO WHILE ( skip_n_rows < ny - nyn ) 2521 READ( 90, * ) 2522 skip_n_rows = skip_n_rows + 1 2523 ENDDO 2524 ! 2525 !-- Read data from nyn to nys and nxl to nxr. Therefore, skip 2526 !-- column until nxl-1 is reached 2527 ALLOCATE ( buildings_f%var_2d(nys:nyn,nxl:nxr) ) 2528 DO j = nyn, nys, -1 2529 2530 READ( 90, *, IOSTAT=io_status ) & 2531 ( dum, i = 0, nxl-1 ), & 2532 ( buildings_f%var_2d(j,i), i = nxl, nxr ) 2533 2534 IF ( io_status > 0 ) THEN 2535 WRITE( message_string, '(A,1X,I5,1X,A)' ) 'error reading line', ny-j+1, & 2536 'of file TOPOGRAPHY_DATA'//TRIM( coupling_char ) 2537 CALL message( 'netcdf_data_input_mod', 'PA0209', 2, 2, myid, 6, 0 ) 2538 ELSEIF ( io_status < 0 ) THEN 2539 WRITE( message_string, '(A,1X,I5)' ) 'end of line or file detected for '// & 2540 'file TOPOGRAPHY_DATA'//TRIM( coupling_char )//' at line', ny-j+1 2541 CALL message( 'netcdf_data_input_mod', 'PA0704', 2, 2, myid, 6, 0 ) 2542 ENDIF 2543 2544 ENDDO 2545 2546 CLOSE( 90 ) 2547 buildings_f%from_file = .TRUE. 2548 2549 ENDIF 2550 #if defined( __parallel ) 2551 CALL MPI_BARRIER( comm2d, ierr ) 2552 #endif 2553 ENDDO 2554 2555 ENDIF 2556 ! 2557 !-- End of CPU measurement 2558 CALL cpu_log( log_point_s(83), 'NetCDF/ASCII input topo', 'stop' ) 2559 ! 2560 !-- Check for minimum requirement to setup building topography. If buildings 2561 !-- are provided, also an ID and a type are required. 2562 !-- Note, doing this check in check_parameters 2563 !-- will be too late (data will be used for grid inititialization before). 2564 IF ( input_pids_static ) THEN 2565 IF ( buildings_f%from_file .AND. & 2566 .NOT. building_id_f%from_file ) THEN 2567 message_string = 'If building heights are prescribed in ' // & 2568 'static input file, also an ID is required.' 2569 CALL message( 'netcdf_data_input_mod', 'PA0542', 1, 2, 0, 6, 0 ) 2239 message_string = 'NetCDF attribute lod ' // & 2240 '(level of detail) is not set ' // & 2241 'properly for buildings_2d.' 2242 CALL message( 'netcdf_data_input_mod', 'PA0540', 1, 2, 0, 6, 0 ) 2570 2243 ENDIF 2571 2244 ENDIF 2572 2573 IF ( terrain_height_f%from_file ) THEN 2574 ! 2575 !-- Check orography for fill-values. 2576 !-- For the moment, give an error message. More advanced methods, e.g. a 2577 !-- nearest neighbor algorithm as used in GIS systems might be implemented 2578 !-- later. 2579 !-- NOTE: This check must be placed here as terrain_height_f is altered 2580 !-- within init_grid which is called before netcdf_data_input_check_static 2581 IF ( ANY( terrain_height_f%var == terrain_height_f%fill ) ) THEN 2582 message_string = 'NetCDF variable zt is not ' // & 2583 'allowed to have missing data' 2584 CALL message( 'netcdf_data_input_mod', 'PA0550', 2, 2, myid, 6, 0 ) 2245 ! 2246 !-- If available, also read 3D building information. If both are available, use 3D information. 2247 IF ( check_existence( var_names, 'buildings_3d' ) ) THEN 2248 buildings_f%from_file = .TRUE. 2249 CALL get_attribute( id_topo, char_lod, buildings_f%lod, .FALSE., 'buildings_3d' ) 2250 CALL get_attribute( id_topo, char_fill, buildings_f%fill2, .FALSE., 'buildings_3d' ) 2251 CALL get_dimension_length( id_topo, buildings_f%nz, 'z' ) 2252 ! 2253 !-- Read 3D buildings 2254 IF ( buildings_f%lod == 2 ) THEN 2255 ALLOCATE( buildings_f%z(nzb:buildings_f%nz-1) ) 2256 CALL get_variable( id_topo, 'z', buildings_f%z ) 2257 ALLOCATE( buildings_f%var_3d(nzb:buildings_f%nz-1, nys:nyn,nxl:nxr) ) 2258 buildings_f%var_3d = 0 2259 CALL get_variable( id_topo, 'buildings_3d', buildings_f%var_3d, nxl, nxr, nys, nyn, 0,& 2260 buildings_f%nz-1 ) 2261 ELSE 2262 message_string = 'NetCDF attribute lod (level of detail) is not set ' // & 2263 'properly for buildings_3d.' 2264 CALL message( 'netcdf_data_input_mod', 'PA0541', 1, 2, 0, 6, 0 ) 2585 2265 ENDIF 2266 ENDIF 2267 ! 2268 !-- Read building IDs and its FillValue attribute. Further required for mapping buildings on top 2269 !-- of orography. 2270 IF ( check_existence( var_names, 'building_id' ) ) THEN 2271 building_id_f%from_file = .TRUE. 2272 CALL get_attribute( id_topo, char_fill, building_id_f%fill, .FALSE., 'building_id' ) 2273 ALLOCATE( building_id_f%var(nys:nyn,nxl:nxr) ) 2274 CALL get_variable( id_topo, 'building_id', building_id_f%var, nxl, nxr, nys, nyn ) 2586 2275 ELSE 2587 ! 2588 !-- In case no terrain height is provided by static input file, allocate 2589 !-- array nevertheless and set terrain height to 0, which simplifies 2590 !-- topography initialization. 2591 ALLOCATE ( terrain_height_f%var(nys:nyn,nxl:nxr) ) 2592 terrain_height_f%var = 0.0_wp 2276 building_id_f%from_file = .FALSE. 2593 2277 ENDIF 2594 2278 ! 2595 !-- Finally, exchange 1 ghost point for building ID and type. 2596 !-- In case of non-cyclic boundary conditions set Neumann conditions at the 2597 !-- lateral boundaries. 2598 IF ( building_id_f%from_file ) THEN 2599 CALL resize_array_2d_int32( building_id_f%var, nys, nyn, nxl, nxr ) 2600 CALL exchange_horiz_2d_int( building_id_f%var, nys, nyn, nxl, nxr, & 2601 nbgp ) 2279 !-- Read building_type and required attributes. 2280 IF ( check_existence( var_names, 'building_type' ) ) THEN 2281 building_type_f%from_file = .TRUE. 2282 CALL get_attribute( id_topo, char_fill, building_type_f%fill, .FALSE., 'building_type' ) 2283 ALLOCATE( building_type_f%var(nys:nyn,nxl:nxr) ) 2284 CALL get_variable( id_topo, 'building_type', building_type_f%var, nxl, nxr, nys, nyn ) 2285 ELSE 2286 building_type_f%from_file = .FALSE. 2602 2287 ENDIF 2603 2604 IF ( building_type_f%from_file ) THEN 2605 CALL resize_array_2d_int8( building_type_f%var, nys, nyn, nxl, nxr ) 2606 CALL exchange_horiz_2d_byte( building_type_f%var, nys, nyn, nxl, nxr, & 2607 nbgp ) 2288 ! 2289 !-- Close topography input file 2290 CALL close_input_file( id_topo ) 2291 #else 2292 CONTINUE 2293 #endif 2294 ! 2295 !-- ASCII input 2296 ELSEIF ( TRIM( topography ) == 'read_from_file' ) THEN 2297 2298 DO ii = 0, io_blocks-1 2299 IF ( ii == io_group ) THEN 2300 2301 OPEN( 90, FILE='TOPOGRAPHY_DATA' // TRIM( coupling_char ), STATUS='OLD', & 2302 FORM='FORMATTED', IOSTAT=io_status ) 2303 2304 IF ( io_status > 0 ) THEN 2305 message_string = 'file TOPOGRAPHY_DATA' // & 2306 TRIM( coupling_char ) // ' does not exist' 2307 CALL message( 'netcdf_data_input_mod', 'PA0208', 1, 2, 0, 6, 0 ) 2308 ENDIF 2309 2310 ! 2311 !-- Read topography PE-wise. Rows are read from nyn to nys, columns are read from nxl to 2312 !-- nxr. At first, ny-nyn rows need to be skipped. 2313 skip_n_rows = 0 2314 DO WHILE ( skip_n_rows < ny - nyn ) 2315 READ( 90, * ) 2316 skip_n_rows = skip_n_rows + 1 2317 ENDDO 2318 ! 2319 !-- Read data from nyn to nys and nxl to nxr. Therefore, skip column until nxl-1 is reached 2320 ALLOCATE( buildings_f%var_2d(nys:nyn,nxl:nxr) ) 2321 DO j = nyn, nys, -1 2322 2323 READ( 90, *, IOSTAT=io_status ) ( dum, i = 0, nxl-1 ), & 2324 ( buildings_f%var_2d(j,i), i = nxl, nxr ) 2325 2326 IF ( io_status > 0 ) THEN 2327 WRITE( message_string, '(A,1X,I5,1X,A)' ) 'error reading line', ny-j+1, & 2328 'of file TOPOGRAPHY_DATA' // TRIM( coupling_char ) 2329 CALL message( 'netcdf_data_input_mod', 'PA0209', 2, 2, myid, 6, 0 ) 2330 ELSEIF ( io_status < 0 ) THEN 2331 WRITE( message_string, '(A,1X,I5)' ) 'end of line or file detected for '// & 2332 'file TOPOGRAPHY_DATA' // TRIM( coupling_char ) // ' at line', ny-j+1 2333 CALL message( 'netcdf_data_input_mod', 'PA0704', 2, 2, myid, 6, 0 ) 2334 ENDIF 2335 2336 ENDDO 2337 2338 CLOSE( 90 ) 2339 buildings_f%from_file = .TRUE. 2340 2341 ENDIF 2342 #if defined( __parallel ) 2343 CALL MPI_BARRIER( comm2d, ierr ) 2344 #endif 2345 ENDDO 2346 2347 ENDIF 2348 ! 2349 !-- End of CPU measurement 2350 CALL cpu_log( log_point_s(83), 'NetCDF/ASCII input topo', 'stop' ) 2351 2352 ! 2353 !-- Check for minimum requirement to setup building topography. If buildings are provided, also an 2354 !-- ID and a type are required. 2355 !-- Note, doing this check in check_parameters will be too late (data will be used for grid 2356 !-- inititialization before). 2357 IF ( input_pids_static ) THEN 2358 IF ( buildings_f%from_file .AND. .NOT. building_id_f%from_file ) THEN 2359 message_string = 'If building heights are prescribed in ' // & 2360 'static input file, also an ID is required.' 2361 CALL message( 'netcdf_data_input_mod', 'PA0542', 1, 2, 0, 6, 0 ) 2608 2362 ENDIF 2609 2610 END SUBROUTINE netcdf_data_input_topo 2611 2612 !------------------------------------------------------------------------------! 2363 ENDIF 2364 2365 IF ( terrain_height_f%from_file ) THEN 2366 ! 2367 !-- Check orography for fill-values. 2368 !-- For the moment, give an error message. More advanced methods, e.g. a nearest neighbor 2369 !-- algorithm as used in GIS systems might be implemented later. 2370 !-- Note: This check must be placed here as terrain_height_f is altered within init_grid which is 2371 !-- called before netcdf_data_input_check_static 2372 IF ( ANY( terrain_height_f%var == terrain_height_f%fill ) ) THEN 2373 message_string = 'NetCDF variable zt is not ' // 'allowed to have missing data' 2374 CALL message( 'netcdf_data_input_mod', 'PA0550', 2, 2, myid, 6, 0 ) 2375 ENDIF 2376 ELSE 2377 ! 2378 !-- In case no terrain height is provided by static input file, allocate array nevertheless and 2379 !-- set terrain height to 0, which simplifies topography initialization. 2380 ALLOCATE( terrain_height_f%var(nys:nyn,nxl:nxr) ) 2381 terrain_height_f%var = 0.0_wp 2382 ENDIF 2383 ! 2384 !-- Finally, exchange 1 ghost point for building ID and type. 2385 !-- In case of non-cyclic boundary conditions set Neumann conditions at the lateral boundaries. 2386 IF ( building_id_f%from_file ) THEN 2387 CALL resize_array_2d_int32( building_id_f%var, nys, nyn, nxl, nxr ) 2388 CALL exchange_horiz_2d_int( building_id_f%var, nys, nyn, nxl, nxr, nbgp ) 2389 ENDIF 2390 2391 IF ( building_type_f%from_file ) THEN 2392 CALL resize_array_2d_int8( building_type_f%var, nys, nyn, nxl, nxr ) 2393 CALL exchange_horiz_2d_byte( building_type_f%var, nys, nyn, nxl, nxr, nbgp ) 2394 ENDIF 2395 2396 END SUBROUTINE netcdf_data_input_topo 2397 2398 2399 !--------------------------------------------------------------------------------------------------! 2613 2400 ! Description: 2614 2401 ! ------------ 2615 !> Reads initialization data of u, v, w, pt, q, geostrophic wind components, 2616 !> as well as soil moisture and soil temperature, derived from larger-scale 2617 !> model (COSMO) by Inifor. 2618 !------------------------------------------------------------------------------! 2619 SUBROUTINE netcdf_data_input_init_3d 2620 2621 USE arrays_3d, & 2622 ONLY: q, pt, u, v, w, zu, zw 2623 2624 USE control_parameters, & 2625 ONLY: air_chemistry, bc_lr_cyc, bc_ns_cyc, humidity, & 2626 message_string, neutral 2627 2628 USE indices, & 2629 ONLY: nx, nxl, nxlu, nxr, ny, nyn, nys, nysv, nzb, nz, nzt 2630 2631 IMPLICIT NONE 2632 2633 CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names 2634 2635 LOGICAL :: dynamic_3d = .TRUE. !< flag indicating that 3D data is read from dynamic file 2636 2637 INTEGER(iwp) :: id_dynamic !< NetCDF id of dynamic input file 2638 INTEGER(iwp) :: n !< running index for chemistry variables 2639 INTEGER(iwp) :: num_vars !< number of variables in netcdf input file 2640 2641 LOGICAL :: check_passed !< flag indicating if a check passed 2642 2643 ! 2644 !-- Skip routine if no input file with dynamic input data is available. 2645 IF ( .NOT. input_pids_dynamic ) RETURN 2646 ! 2647 !-- Please note, Inifor is designed to provide initial data for u and v for 2648 !-- the prognostic grid points in case of lateral Dirichlet conditions. 2649 !-- This means that Inifor provides data from nxlu:nxr (for u) and 2650 !-- from nysv:nyn (for v) at the left and south domain boundary, respectively. 2651 !-- However, as work-around for the moment, PALM will run with cyclic 2652 !-- conditions and will be initialized with data provided by Inifor 2653 !-- boundaries in case of Dirichlet. 2654 !-- Hence, simply set set nxlu/nysv to 1 (will be reset to its original value 2655 !-- at the end of this routine. 2656 IF ( bc_lr_cyc .AND. nxl == 0 ) nxlu = 1 2657 IF ( bc_ns_cyc .AND. nys == 0 ) nysv = 1 2658 2659 ! 2660 !-- CPU measurement 2661 CALL cpu_log( log_point_s(85), 'NetCDF input init', 'start' ) 2402 !> Reads initialization data of u, v, w, pt, q, geostrophic wind components, as well as soil 2403 !> moisture and soil temperature, derived from larger-scale model (COSMO) by Inifor. 2404 !--------------------------------------------------------------------------------------------------! 2405 SUBROUTINE netcdf_data_input_init_3d 2406 2407 USE arrays_3d, & 2408 ONLY: pt, q, u, v, w, zu, zw 2409 2410 USE control_parameters, & 2411 ONLY: air_chemistry, bc_lr_cyc, bc_ns_cyc, humidity, message_string, neutral 2412 2413 USE indices, & 2414 ONLY: nx, nxl, nxlu, nxr, ny, nyn, nys, nysv, nzb, nz, nzt 2415 2416 IMPLICIT NONE 2417 2418 CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: var_names 2419 2420 INTEGER(iwp) :: id_dynamic !< NetCDF id of dynamic input file 2421 INTEGER(iwp) :: n !< running index for chemistry variables 2422 INTEGER(iwp) :: num_vars !< number of variables in netcdf input file 2423 2424 LOGICAL :: check_passed !< flag indicating if a check passed 2425 LOGICAL :: dynamic_3d = .TRUE. !< flag indicating that 3D data is read from dynamic file 2426 2427 ! 2428 !-- Skip routine if no input file with dynamic input data is available. 2429 IF ( .NOT. input_pids_dynamic ) RETURN 2430 ! 2431 !-- Please note, Inifor is designed to provide initial data for u and v for the prognostic grid 2432 !-- points in case of lateral Dirichlet conditions. 2433 !-- This means that Inifor provides data from nxlu:nxr (for u) and from nysv:nyn (for v) at the left 2434 !-- and south domain boundary, respectively. 2435 !-- However, as work-around for the moment, PALM will run with cyclic conditions and will be 2436 !-- initialized with data provided by Inifor boundaries in case of Dirichlet. 2437 !-- Hence, simply set set nxlu/nysv to 1 (will be reset to its original value at the end of this 2438 !-- routine). 2439 IF ( bc_lr_cyc .AND. nxl == 0 ) nxlu = 1 2440 IF ( bc_ns_cyc .AND. nys == 0 ) nysv = 1 2441 2442 ! 2443 !-- CPU measurement 2444 CALL cpu_log( log_point_s(85), 'NetCDF input init', 'start' ) 2662 2445 2663 2446 #if defined ( __netcdf ) 2664 2447 ! 2665 !-- Open file in read-only mode 2666 CALL open_read_file( TRIM( input_file_dynamic ) // & 2667 TRIM( coupling_char ), id_dynamic ) 2668 2669 ! 2670 !-- At first, inquire all variable names. 2671 CALL inquire_num_variables( id_dynamic, num_vars ) 2672 ! 2673 !-- Allocate memory to store variable names. 2674 ALLOCATE( var_names(1:num_vars) ) 2675 CALL inquire_variable_names( id_dynamic, var_names ) 2676 ! 2677 !-- Read vertical dimension of scalar und w grid. 2678 CALL get_dimension_length( id_dynamic, init_3d%nzu, 'z' ) 2679 CALL get_dimension_length( id_dynamic, init_3d%nzw, 'zw' ) 2680 ! 2681 !-- Read also the horizontal dimensions. These are used just used fo 2682 !-- checking the compatibility with the PALM grid before reading. 2683 CALL get_dimension_length( id_dynamic, init_3d%nx, 'x' ) 2684 CALL get_dimension_length( id_dynamic, init_3d%nxu, 'xu' ) 2685 CALL get_dimension_length( id_dynamic, init_3d%ny, 'y' ) 2686 CALL get_dimension_length( id_dynamic, init_3d%nyv, 'yv' ) 2687 2688 ! 2689 !-- Check for correct horizontal and vertical dimension. Please note, 2690 !-- checks are performed directly here and not called from 2691 !-- check_parameters as some varialbes are still not allocated there. 2692 !-- Moreover, please note, u- and v-grid has 1 grid point less on 2693 !-- Inifor grid. 2694 IF ( init_3d%nx-1 /= nx .OR. init_3d%nxu-1 /= nx - 1 .OR. & 2695 init_3d%ny-1 /= ny .OR. init_3d%nyv-1 /= ny - 1 ) THEN 2696 message_string = 'Number of horizontal grid points in '// & 2697 'dynamic input file does not match ' // & 2698 'the number of numeric grid points.' 2699 CALL message( 'netcdf_data_input_mod', 'PA0543', 1, 2, 0, 6, 0 ) 2448 !-- Open file in read-only mode 2449 CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), id_dynamic ) 2450 2451 ! 2452 !-- At first, inquire all variable names. 2453 CALL inquire_num_variables( id_dynamic, num_vars ) 2454 ! 2455 !-- Allocate memory to store variable names. 2456 ALLOCATE( var_names(1:num_vars) ) 2457 CALL inquire_variable_names( id_dynamic, var_names ) 2458 ! 2459 !-- Read vertical dimension of scalar und w grid. 2460 CALL get_dimension_length( id_dynamic, init_3d%nzu, 'z' ) 2461 CALL get_dimension_length( id_dynamic, init_3d%nzw, 'zw' ) 2462 ! 2463 !-- Read also the horizontal dimensions. These are used just used for checking the compatibility 2464 !-- with the PALM grid before reading. 2465 CALL get_dimension_length( id_dynamic, init_3d%nx, 'x' ) 2466 CALL get_dimension_length( id_dynamic, init_3d%nxu, 'xu' ) 2467 CALL get_dimension_length( id_dynamic, init_3d%ny, 'y' ) 2468 CALL get_dimension_length( id_dynamic, init_3d%nyv, 'yv' ) 2469 2470 ! 2471 !-- Check for correct horizontal and vertical dimension. Please note, checks are performed directly 2472 !-- here and not called from check_parameters as some varialbes are still not allocated there. 2473 !-- Moreover, please note, u- and v-grid has 1 grid point less on Inifor grid. 2474 IF ( init_3d%nx-1 /= nx .OR. init_3d%nxu-1 /= nx - 1 .OR. & 2475 init_3d%ny-1 /= ny .OR. init_3d%nyv-1 /= ny - 1 ) THEN 2476 message_string = 'Number of horizontal grid points in '// & 2477 'dynamic input file does not match ' // & 2478 'the number of numeric grid points.' 2479 CALL message( 'netcdf_data_input_mod', 'PA0543', 1, 2, 0, 6, 0 ) 2480 ENDIF 2481 2482 IF ( init_3d%nzu /= nz ) THEN 2483 message_string = 'Number of vertical grid points in '// & 2484 'dynamic input file does not match ' // & 2485 'the number of numeric grid points.' 2486 CALL message( 'netcdf_data_input_mod', 'PA0543', 1, 2, 0, 6, 0 ) 2487 ENDIF 2488 ! 2489 !-- Read vertical dimensions. Later, these are required for eventual inter- and extrapolations of 2490 !-- the initialization data. 2491 IF ( check_existence( var_names, 'z' ) ) THEN 2492 ALLOCATE( init_3d%zu_atmos(1:init_3d%nzu) ) 2493 CALL get_variable( id_dynamic, 'z', init_3d%zu_atmos ) 2494 ENDIF 2495 IF ( check_existence( var_names, 'zw' ) ) THEN 2496 ALLOCATE( init_3d%zw_atmos(1:init_3d%nzw) ) 2497 CALL get_variable( id_dynamic, 'zw', init_3d%zw_atmos ) 2498 ENDIF 2499 ! 2500 !-- Check for consistency between vertical coordinates in dynamic driver and numeric grid. 2501 !-- Please note, depending on compiler options both may be equal up to a certain threshold, and 2502 !-- differences between the numeric grid and vertical coordinate in the driver can built-up to 2503 !-- 10E-1-10E-0 m. For this reason, the check is performed not for exactly matching values. 2504 IF ( ANY( ABS( zu(1:nzt) - init_3d%zu_atmos(1:init_3d%nzu) ) > 10E-1 ) .OR. & 2505 ANY( ABS( zw(1:nzt-1) - init_3d%zw_atmos(1:init_3d%nzw) ) > 10E-1 ) ) THEN 2506 message_string = 'Vertical grid in dynamic driver does not ' // 'match the numeric grid.' 2507 CALL message( 'netcdf_data_input_mod', 'PA0543', 1, 2, 0, 6, 0 ) 2508 ENDIF 2509 ! 2510 !-- Read initial geostrophic wind components at t = 0 (index 1 in file). 2511 IF ( check_existence( var_names, 'ls_forcing_ug' ) ) THEN 2512 ALLOCATE( init_3d%ug_init(nzb:nzt+1) ) 2513 init_3d%ug_init = 0.0_wp 2514 CALL get_variable_pr( id_dynamic, 'ls_forcing_ug', 1, init_3d%ug_init(1:nzt) ) 2515 ! 2516 !-- Set top-boundary condition (Neumann) 2517 init_3d%ug_init(nzt+1) = init_3d%ug_init(nzt) 2518 init_3d%from_file_ug = .TRUE. 2519 ELSE 2520 init_3d%from_file_ug = .FALSE. 2521 ENDIF 2522 2523 IF ( check_existence( var_names, 'ls_forcing_vg' ) ) THEN 2524 ALLOCATE( init_3d%vg_init(nzb:nzt+1) ) 2525 init_3d%vg_init = 0.0_wp 2526 CALL get_variable_pr( id_dynamic, 'ls_forcing_vg', 1, init_3d%vg_init(1:nzt) ) 2527 ! 2528 !-- Set top-boundary condition (Neumann) 2529 init_3d%vg_init(nzt+1) = init_3d%vg_init(nzt) 2530 init_3d%from_file_vg = .TRUE. 2531 ELSE 2532 init_3d%from_file_vg = .FALSE. 2533 ENDIF 2534 ! 2535 !-- Read inital 3D data of u, v, w, pt and q, derived from COSMO model. Read PE-wise yz-slices. 2536 !-- Please note, the u-, v- and w-component are defined on different grids with one element less in 2537 !-- the x-, y-, and z-direction, respectively. Hence, reading is subdivided into separate loops. 2538 !-- Read u-component 2539 IF ( check_existence( var_names, 'init_atmosphere_u' ) ) THEN 2540 ! 2541 !-- Read attributes for the fill value and level-of-detail 2542 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_u, .FALSE., 'init_atmosphere_u' ) 2543 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_u, .FALSE., 'init_atmosphere_u' ) 2544 ! 2545 !-- level-of-detail 1 - read initialization profile 2546 IF ( init_3d%lod_u == 1 ) THEN 2547 ALLOCATE( init_3d%u_init(nzb:nzt+1) ) 2548 init_3d%u_init = 0.0_wp 2549 CALL get_variable( id_dynamic, 'init_atmosphere_u', init_3d%u_init(nzb+1:nzt) ) 2550 ! 2551 !-- Set top-boundary condition (Neumann) 2552 init_3d%u_init(nzt+1) = init_3d%u_init(nzt) 2553 ! 2554 !-- level-of-detail 2 - read 3D initialization data 2555 ELSEIF ( init_3d%lod_u == 2 ) THEN 2556 CALL get_variable( id_dynamic, 'init_atmosphere_u', u(nzb+1:nzt,nys:nyn,nxlu:nxr), & 2557 nxlu, nys+1, nzb+1, nxr-nxlu+1, nyn-nys+1, init_3d%nzu, dynamic_3d ) 2558 ! 2559 !-- Set value at leftmost model grid point nxl = 0. This is because Inifor provides data only 2560 !-- from 1:nx-1 since it assumes non-cyclic conditions. 2561 IF ( nxl == 0 ) u(nzb+1:nzt,nys:nyn,nxl) = u(nzb+1:nzt,nys:nyn,nxlu) 2562 ! 2563 !-- Set bottom and top-boundary 2564 u(nzb,:,:) = u(nzb+1,:,:) 2565 u(nzt+1,:,:) = u(nzt,:,:) 2700 2566 ENDIF 2701 2702 IF ( init_3d%nzu /= nz ) THEN 2703 message_string = 'Number of vertical grid points in '// & 2704 'dynamic input file does not match ' // & 2705 'the number of numeric grid points.' 2706 CALL message( 'netcdf_data_input_mod', 'PA0543', 1, 2, 0, 6, 0 ) 2567 init_3d%from_file_u = .TRUE. 2568 ELSE 2569 message_string = 'Missing initial data for u-component' 2570 CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 ) 2571 ENDIF 2572 ! 2573 !-- Read v-component 2574 IF ( check_existence( var_names, 'init_atmosphere_v' ) ) THEN 2575 ! 2576 !-- Read attributes for the fill value and level-of-detail 2577 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_v, .FALSE., 'init_atmosphere_v' ) 2578 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_v, .FALSE., 'init_atmosphere_v' ) 2579 ! 2580 !-- level-of-detail 1 - read initialization profile 2581 IF ( init_3d%lod_v == 1 ) THEN 2582 ALLOCATE( init_3d%v_init(nzb:nzt+1) ) 2583 init_3d%v_init = 0.0_wp 2584 CALL get_variable( id_dynamic, 'init_atmosphere_v', init_3d%v_init(nzb+1:nzt) ) 2585 ! 2586 !-- Set top-boundary condition (Neumann) 2587 init_3d%v_init(nzt+1) = init_3d%v_init(nzt) 2588 ! 2589 !-- level-of-detail 2 - read 3D initialization data 2590 ELSEIF ( init_3d%lod_v == 2 ) THEN 2591 2592 CALL get_variable( id_dynamic, 'init_atmosphere_v', v(nzb+1:nzt,nysv:nyn,nxl:nxr), & 2593 nxl+1, nysv, nzb+1, nxr-nxl+1, nyn-nysv+1, init_3d%nzu, dynamic_3d ) 2594 ! 2595 !-- Set value at southmost model grid point nys = 0. This is because Inifor provides data only 2596 !-- from 1:ny-1 since it assumes non-cyclic conditions. 2597 IF ( nys == 0 ) v(nzb+1:nzt,nys,nxl:nxr) = v(nzb+1:nzt,nysv,nxl:nxr) 2598 ! 2599 !-- Set bottom and top-boundary 2600 v(nzb,:,:) = v(nzb+1,:,:) 2601 v(nzt+1,:,:) = v(nzt,:,:) 2707 2602 ENDIF 2708 ! 2709 !-- Read vertical dimensions. Later, these are required for eventual 2710 !-- inter- and extrapolations of the initialization data. 2711 IF ( check_existence( var_names, 'z' ) ) THEN 2712 ALLOCATE( init_3d%zu_atmos(1:init_3d%nzu) ) 2713 CALL get_variable( id_dynamic, 'z', init_3d%zu_atmos ) 2603 init_3d%from_file_v = .TRUE. 2604 ELSE 2605 message_string = 'Missing initial data for v-component' 2606 CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 ) 2607 ENDIF 2608 ! 2609 !-- Read w-component 2610 IF ( check_existence( var_names, 'init_atmosphere_w' ) ) THEN 2611 ! 2612 !-- Read attributes for the fill value and level-of-detail 2613 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_w, .FALSE., 'init_atmosphere_w' ) 2614 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_w, .FALSE., 'init_atmosphere_w' ) 2615 ! 2616 !-- level-of-detail 1 - read initialization profile 2617 IF ( init_3d%lod_w == 1 ) THEN 2618 ALLOCATE( init_3d%w_init(nzb:nzt+1) ) 2619 init_3d%w_init = 0.0_wp 2620 CALL get_variable( id_dynamic, 'init_atmosphere_w', init_3d%w_init(nzb+1:nzt-1) ) 2621 ! 2622 !-- Set top-boundary condition (Neumann) 2623 init_3d%w_init(nzt:nzt+1) = init_3d%w_init(nzt-1) 2624 ! 2625 !-- level-of-detail 2 - read 3D initialization data 2626 ELSEIF ( init_3d%lod_w == 2 ) THEN 2627 2628 CALL get_variable( id_dynamic, 'init_atmosphere_w', w(nzb+1:nzt-1,nys:nyn,nxl:nxr), & 2629 nxl+1, nys+1, nzb+1, nxr-nxl+1, nyn-nys+1, init_3d%nzw, dynamic_3d ) 2630 ! 2631 !-- Set bottom and top-boundary 2632 w(nzb,:,:) = 0.0_wp 2633 w(nzt,:,:) = w(nzt-1,:,:) 2634 w(nzt+1,:,:) = w(nzt-1,:,:) 2714 2635 ENDIF 2715 IF ( check_existence( var_names, 'zw' ) ) THEN2716 ALLOCATE( init_3d%zw_atmos(1:init_3d%nzw) )2717 CALL get_variable( id_dynamic, 'zw', init_3d%zw_atmos )2718 ENDIF2719 ! 2720 ! -- Check for consistency between vertical coordinates in dynamic2721 !-- driver and numeric grid.2722 !-- Please note, depending on compiler options both may be 2723 !-- equal up to a certain threshold, and differences between 2724 ! -- the numeric grid and vertical coordinate in the driver can built-2725 !-- up to 10E-1-10E-0 m. For this reason, the check is performed not2726 !-- for exactly matching values. 2727 IF ( ANY( ABS( zu(1:nzt) - init_3d%zu_atmos(1:init_3d%nzu) ) &2728 > 10E-1 ) .OR. & 2729 ANY( ABS( zw(1:nzt-1) - init_3d%zw_atmos(1:init_3d%nzw) ) & 2730 > 10E-1 )) THEN2731 message_string = 'Vertical grid in dynamic driver does not '// &2732 'match the numeric grid.'2733 CALL message( 'netcdf_data_input_mod', 'PA0543', 1, 2, 0, 6, 0 ) 2734 ENDIF 2735 ! 2736 !-- Read initial geostrophic wind components at 2737 ! -- t = 0 (index 1 in file).2738 IF ( check_existence( var_names, 'ls_forcing_ug' ) ) THEN 2739 ALLOCATE( init_3d%ug_init(nzb:nzt+1) )2740 init_3d%ug_init = 0.0_wp 2741 2742 CALL get_variable_pr( id_dynamic, 'ls_forcing_ug', 1, &2743 init_3d%ug_init(1:nzt) ) 2744 ! 2745 !-- Set top-boundary condition (Neumann)2746 init_3d%ug_init(nzt+1) = init_3d%ug_init(nzt)2747 2748 init_3d%from_file_ ug= .TRUE.2636 init_3d%from_file_w = .TRUE. 2637 ELSE 2638 message_string = 'Missing initial data for w-component' 2639 CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 ) 2640 ENDIF 2641 ! 2642 !-- Read potential temperature 2643 IF ( .NOT. neutral ) THEN 2644 IF ( check_existence( var_names, 'init_atmosphere_pt' ) ) THEN 2645 ! 2646 !-- Read attributes for the fill value and level-of-detail 2647 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_pt, .FALSE., 'init_atmosphere_pt') 2648 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_pt, .FALSE., 'init_atmosphere_pt' ) 2649 ! 2650 !-- level-of-detail 1 - read initialization profile 2651 IF ( init_3d%lod_pt == 1 ) THEN 2652 ALLOCATE( init_3d%pt_init(nzb:nzt+1) ) 2653 CALL get_variable( id_dynamic, 'init_atmosphere_pt', init_3d%pt_init(nzb+1:nzt) ) 2654 ! 2655 !-- Set Neumann top and surface boundary condition for initial profil 2656 init_3d%pt_init(nzb) = init_3d%pt_init(nzb+1) 2657 init_3d%pt_init(nzt+1) = init_3d%pt_init(nzt) 2658 ! 2659 !-- level-of-detail 2 - read 3D initialization data 2660 ELSEIF ( init_3d%lod_pt == 2 ) THEN 2661 2662 CALL get_variable( id_dynamic, 'init_atmosphere_pt', pt(nzb+1:nzt,nys:nyn,nxl:nxr), & 2663 nxl+1, nys+1, nzb+1, nxr-nxl+1, nyn-nys+1, init_3d%nzu, dynamic_3d ) 2664 ! 2665 !-- Set bottom and top-boundary 2666 pt(nzb,:,:) = pt(nzb+1,:,:) 2667 pt(nzt+1,:,:) = pt(nzt,:,:) 2668 ENDIF 2669 init_3d%from_file_pt = .TRUE. 2749 2670 ELSE 2750 init_3d%from_file_ug = .FALSE. 2751 ENDIF 2752 IF ( check_existence( var_names, 'ls_forcing_vg' ) ) THEN 2753 ALLOCATE( init_3d%vg_init(nzb:nzt+1) ) 2754 init_3d%vg_init = 0.0_wp 2755 2756 CALL get_variable_pr( id_dynamic, 'ls_forcing_vg', 1, & 2757 init_3d%vg_init(1:nzt) ) 2758 ! 2759 !-- Set top-boundary condition (Neumann) 2760 init_3d%vg_init(nzt+1) = init_3d%vg_init(nzt) 2761 2762 init_3d%from_file_vg = .TRUE. 2763 ELSE 2764 init_3d%from_file_vg = .FALSE. 2765 ENDIF 2766 ! 2767 !-- Read inital 3D data of u, v, w, pt and q, 2768 !-- derived from COSMO model. Read PE-wise yz-slices. 2769 !-- Please note, the u-, v- and w-component are defined on different 2770 !-- grids with one element less in the x-, y-, 2771 !-- and z-direction, respectively. Hence, reading is subdivided 2772 !-- into separate loops. 2773 !-- Read u-component 2774 IF ( check_existence( var_names, 'init_atmosphere_u' ) ) THEN 2775 ! 2776 !-- Read attributes for the fill value and level-of-detail 2777 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_u, & 2778 .FALSE., 'init_atmosphere_u' ) 2779 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_u, & 2780 .FALSE., 'init_atmosphere_u' ) 2781 ! 2782 !-- level-of-detail 1 - read initialization profile 2783 IF ( init_3d%lod_u == 1 ) THEN 2784 ALLOCATE( init_3d%u_init(nzb:nzt+1) ) 2785 init_3d%u_init = 0.0_wp 2786 2787 CALL get_variable( id_dynamic, 'init_atmosphere_u', & 2788 init_3d%u_init(nzb+1:nzt) ) 2789 ! 2790 !-- Set top-boundary condition (Neumann) 2791 init_3d%u_init(nzt+1) = init_3d%u_init(nzt) 2792 ! 2793 !-- level-of-detail 2 - read 3D initialization data 2794 ELSEIF ( init_3d%lod_u == 2 ) THEN 2795 CALL get_variable( id_dynamic, 'init_atmosphere_u', & 2796 u(nzb+1:nzt,nys:nyn,nxlu:nxr), & 2797 nxlu, nys+1, nzb+1, & 2798 nxr-nxlu+1, nyn-nys+1, init_3d%nzu, & 2799 dynamic_3d ) 2800 ! 2801 !-- Set value at leftmost model grid point nxl = 0. This is because 2802 !-- Inifor provides data only from 1:nx-1 since it assumes non-cyclic 2803 !-- conditions. 2804 IF ( nxl == 0 ) & 2805 u(nzb+1:nzt,nys:nyn,nxl) = u(nzb+1:nzt,nys:nyn,nxlu) 2806 ! 2807 !-- Set bottom and top-boundary 2808 u(nzb,:,:) = u(nzb+1,:,:) 2809 u(nzt+1,:,:) = u(nzt,:,:) 2810 2811 ENDIF 2812 init_3d%from_file_u = .TRUE. 2813 ELSE 2814 message_string = 'Missing initial data for u-component' 2671 message_string = 'Missing initial data for ' // 'potential temperature' 2815 2672 CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 ) 2816 2673 ENDIF 2817 ! 2818 !-- Read v-component 2819 IF ( check_existence( var_names, 'init_atmosphere_v' ) ) THEN 2674 ENDIF 2675 2676 ! 2677 !-- Read mixing ratio 2678 IF ( humidity ) THEN 2679 IF ( check_existence( var_names, 'init_atmosphere_qv' ) ) THEN 2820 2680 ! 2821 2681 !-- Read attributes for the fill value and level-of-detail 2822 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_v, & 2823 .FALSE., 'init_atmosphere_v' ) 2824 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_v, & 2825 .FALSE., 'init_atmosphere_v' ) 2682 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_q, .FALSE., 'init_atmosphere_qv' ) 2683 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_q, .FALSE., 'init_atmosphere_qv' ) 2826 2684 ! 2827 2685 !-- level-of-detail 1 - read initialization profile 2828 IF ( init_3d%lod_v == 1 ) THEN 2829 ALLOCATE( init_3d%v_init(nzb:nzt+1) ) 2830 init_3d%v_init = 0.0_wp 2831 2832 CALL get_variable( id_dynamic, 'init_atmosphere_v', & 2833 init_3d%v_init(nzb+1:nzt) ) 2834 ! 2835 !-- Set top-boundary condition (Neumann) 2836 init_3d%v_init(nzt+1) = init_3d%v_init(nzt) 2686 IF ( init_3d%lod_q == 1 ) THEN 2687 ALLOCATE( init_3d%q_init(nzb:nzt+1) ) 2688 CALL get_variable( id_dynamic, 'init_atmosphere_qv', init_3d%q_init(nzb+1:nzt) ) 2689 ! 2690 !-- Set bottom and top boundary condition (Neumann) 2691 init_3d%q_init(nzb) = init_3d%q_init(nzb+1) 2692 init_3d%q_init(nzt+1) = init_3d%q_init(nzt) 2837 2693 ! 2838 2694 !-- level-of-detail 2 - read 3D initialization data 2839 ELSEIF ( init_3d%lod_v == 2 ) THEN 2840 2841 CALL get_variable( id_dynamic, 'init_atmosphere_v', & 2842 v(nzb+1:nzt,nysv:nyn,nxl:nxr), & 2843 nxl+1, nysv, nzb+1, & 2844 nxr-nxl+1, nyn-nysv+1, init_3d%nzu, & 2845 dynamic_3d ) 2846 ! 2847 !-- Set value at southmost model grid point nys = 0. This is because 2848 !-- Inifor provides data only from 1:ny-1 since it assumes non-cyclic 2849 !-- conditions. 2850 IF ( nys == 0 ) & 2851 v(nzb+1:nzt,nys,nxl:nxr) = v(nzb+1:nzt,nysv,nxl:nxr) 2695 ELSEIF ( init_3d%lod_q == 2 ) THEN 2696 2697 CALL get_variable( id_dynamic, 'init_atmosphere_qv', q(nzb+1:nzt,nys:nyn,nxl:nxr), & 2698 nxl+1, nys+1, nzb+1, nxr-nxl+1, nyn-nys+1, init_3d%nzu, dynamic_3d ) 2852 2699 ! 2853 2700 !-- Set bottom and top-boundary 2854 v(nzb,:,:) = v(nzb+1,:,:) 2855 v(nzt+1,:,:) = v(nzt,:,:) 2856 2701 q(nzb,:,:) = q(nzb+1,:,:) 2702 q(nzt+1,:,:) = q(nzt,:,:) 2857 2703 ENDIF 2858 init_3d%from_file_ v= .TRUE.2704 init_3d%from_file_q = .TRUE. 2859 2705 ELSE 2860 message_string = 'Missing initial data for v-component'2706 message_string = 'Missing initial data for ' // 'mixing ratio' 2861 2707 CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 ) 2862 2708 ENDIF 2863 ! 2864 !-- Read w-component 2865 IF ( check_existence( var_names, 'init_atmosphere_w' ) ) THEN 2866 ! 2867 !-- Read attributes for the fill value and level-of-detail2868 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_w, &2869 .FALSE., 'init_atmosphere_w' ) 2870 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_w, & 2871 .FALSE., 'init_atmosphere_w')2872 ! 2873 !-- level-of-detail 1 - read initialization profile 2874 IF ( init_3d%lod_w == 1 ) THEN 2875 ALLOCATE( init_3d%w_init(nzb:nzt+1))2876 init_3d%w_init = 0.0_wp2877 2878 CALL get_variable( id_dynamic, 'init_atmosphere_w', & 2879 init_3d%w_init(nzb+1:nzt-1) )2880 ! 2881 !-- Set top-boundary condition (Neumann) 2882 init_3d%w_init(nzt:nzt+1) = init_3d%w_init(nzt-1)2883 ! 2884 !-- level-of-detail 2 - read 3D initialization data2885 ELSEIF ( init_3d%lod_w == 2) THEN2886 2887 CALL get_variable( id_dynamic, 'init_atmosphere_w', &2888 w(nzb+1:nzt-1,nys:nyn,nxl:nxr), &2889 nxl+1, nys+1, nzb+1, & 2890 nxr-nxl+1, nyn-nys+1, init_3d%nzw, & 2891 dynamic_3d )2892 ! 2893 ! -- Set bottom and top-boundary2894 w(nzb,:,:) = 0.0_wp 2895 w(nzt,:,:) = w(nzt-1,:,:)2896 w(nzt+1,:,:) = w(nzt-1,:,:)2897 2709 ENDIF 2710 2711 ! 2712 !-- Read chemistry variables. 2713 !-- Please note, for the moment, only LOD=1 is allowed 2714 IF ( air_chemistry ) THEN 2715 ! 2716 !-- Allocate chemistry input profiles, as well as arrays for fill values and LOD's. 2717 ALLOCATE( init_3d%chem_init(nzb:nzt+1,1:UBOUND( init_3d%var_names_chem, 1 )) ) 2718 ALLOCATE( init_3d%fill_chem(1:UBOUND( init_3d%var_names_chem, 1 )) ) 2719 ALLOCATE( init_3d%lod_chem(1:UBOUND( init_3d%var_names_chem, 1 )) ) 2720 2721 DO n = 1, UBOUND( init_3d%var_names_chem, 1 ) 2722 IF ( check_existence( var_names, TRIM( init_3d%var_names_chem(n) ) ) ) THEN 2723 ! 2724 !-- Read attributes for the fill value and level-of-detail 2725 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_chem(n), .FALSE., & 2726 TRIM( init_3d%var_names_chem(n) ) ) 2727 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_chem(n), .FALSE., & 2728 TRIM( init_3d%var_names_chem(n) ) ) 2729 ! 2730 !-- Give message that only LOD=1 is allowed. 2731 IF ( init_3d%lod_chem(n) /= 1 ) THEN 2732 message_string = 'For chemistry variables only LOD=1 is ' // 'allowed.' 2733 CALL message( 'netcdf_data_input_mod', 'PA0586', 1, 2, 0, 6, 0 ) 2734 ENDIF 2735 ! 2736 !-- level-of-detail 1 - read initialization profile 2737 CALL get_variable( id_dynamic, TRIM( init_3d%var_names_chem(n) ), & 2738 init_3d%chem_init(nzb+1:nzt,n) ) 2739 ! 2740 !-- Set bottom and top boundary condition (Neumann) 2741 init_3d%chem_init(nzb,n) = init_3d%chem_init(nzb+1,n) 2742 init_3d%chem_init(nzt+1,n) = init_3d%chem_init(nzt,n) 2743 init_3d%from_file_chem(n) = .TRUE. 2898 2744 ENDIF 2899 init_3d%from_file_w = .TRUE. 2900 ELSE 2901 message_string = 'Missing initial data for w-component' 2902 CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 ) 2745 ENDDO 2746 ENDIF 2747 ! 2748 !-- Close input file 2749 CALL close_input_file( id_dynamic ) 2750 #endif 2751 ! 2752 !-- End of CPU measurement 2753 CALL cpu_log( log_point_s(85), 'NetCDF input init', 'stop' ) 2754 ! 2755 !-- Finally, check if the input data has any fill values. Please note, checks depend on the LOD of 2756 !-- the input data. 2757 IF ( init_3d%from_file_u ) THEN 2758 check_passed = .TRUE. 2759 IF ( init_3d%lod_u == 1 ) THEN 2760 IF ( ANY( init_3d%u_init(nzb+1:nzt+1) == init_3d%fill_u ) ) check_passed = .FALSE. 2761 ELSEIF ( init_3d%lod_u == 2 ) THEN 2762 IF ( ANY( u(nzb+1:nzt+1,nys:nyn,nxlu:nxr) == init_3d%fill_u ) ) check_passed = .FALSE. 2903 2763 ENDIF 2904 ! 2905 !-- Read potential temperature 2906 IF ( .NOT. neutral ) THEN 2907 IF ( check_existence( var_names, 'init_atmosphere_pt' ) ) THEN 2908 ! 2909 !-- Read attributes for the fill value and level-of-detail 2910 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_pt, & 2911 .FALSE., 'init_atmosphere_pt' ) 2912 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_pt, & 2913 .FALSE., 'init_atmosphere_pt' ) 2914 ! 2915 !-- level-of-detail 1 - read initialization profile 2916 IF ( init_3d%lod_pt == 1 ) THEN 2917 ALLOCATE( init_3d%pt_init(nzb:nzt+1) ) 2918 2919 CALL get_variable( id_dynamic, 'init_atmosphere_pt', & 2920 init_3d%pt_init(nzb+1:nzt) ) 2921 ! 2922 !-- Set Neumann top and surface boundary condition for initial 2923 !-- profil 2924 init_3d%pt_init(nzb) = init_3d%pt_init(nzb+1) 2925 init_3d%pt_init(nzt+1) = init_3d%pt_init(nzt) 2926 ! 2927 !-- level-of-detail 2 - read 3D initialization data 2928 ELSEIF ( init_3d%lod_pt == 2 ) THEN 2929 2930 CALL get_variable( id_dynamic, 'init_atmosphere_pt', & 2931 pt(nzb+1:nzt,nys:nyn,nxl:nxr), & 2932 nxl+1, nys+1, nzb+1, & 2933 nxr-nxl+1, nyn-nys+1, init_3d%nzu, & 2934 dynamic_3d ) 2935 2936 ! 2937 !-- Set bottom and top-boundary 2938 pt(nzb,:,:) = pt(nzb+1,:,:) 2939 pt(nzt+1,:,:) = pt(nzt,:,:) 2940 2941 ENDIF 2942 init_3d%from_file_pt = .TRUE. 2943 ELSE 2944 message_string = 'Missing initial data for ' // & 2945 'potential temperature' 2946 CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 ) 2947 ENDIF 2764 IF ( .NOT. check_passed ) THEN 2765 message_string = 'NetCDF input for init_atmosphere_u must ' // & 2766 'not contain any _FillValues' 2767 CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 ) 2948 2768 ENDIF 2949 ! 2950 !-- Read mixing ratio 2951 IF ( humidity ) THEN 2952 IF ( check_existence( var_names, 'init_atmosphere_qv' ) ) THEN 2953 ! 2954 !-- Read attributes for the fill value and level-of-detail 2955 CALL get_attribute( id_dynamic, char_fill, init_3d%fill_q, & 2956 .FALSE., 'init_atmosphere_qv' ) 2957 CALL get_attribute( id_dynamic, char_lod, init_3d%lod_q, & 2958 .FALSE., 'init_atmosphere_qv' ) 2959 ! 2960 !-- level-of-detail 1 - read initialization profile 2961 IF ( init_3d%lod_q == 1 ) THEN 2962 ALLOCATE( init_3d%q_init(nzb:nzt+1) ) 2963 2964 CALL get_variable( id_dynamic, 'init_atmosphere_qv', & 2965 init_3d%q_init(nzb+1:nzt) ) 2966 ! 2967 !-- Set bottom and top boundary condition (Neumann) 2968 init_3d%q_init(nzb) = init_3d%q_init(nzb+1) 2969 init_3d%q_init(nzt+1) = init_3d%q_init(nzt) 2970 ! 2971 !-- level-of-detail 2 - read 3D initialization data 2972 ELSEIF ( init_3d%lod_q == 2 ) THEN 2973 2974 CALL get_variable( id_dynamic, 'init_atmosphere_qv', & 2975 q(nzb+1:nzt,nys:nyn,nxl:nxr), & 2976 nxl+1, nys+1, nzb+1, & 2977 nxr-nxl+1, nyn-nys+1, init_3d%nzu, & 2978 dynamic_3d ) 2979 2980 ! 2981 !-- Set bottom and top-boundary 2982 q(nzb,:,:) = q(nzb+1,:,:) 2983 q(nzt+1,:,:) = q(nzt,:,:) 2984 2985 ENDIF 2986 init_3d%from_file_q = .TRUE. 2987 ELSE 2988 message_string = 'Missing initial data for ' // & 2989 'mixing ratio' 2990 CALL message( 'netcdf_data_input_mod', 'PA0544', 1, 2, 0, 6, 0 ) 2991 ENDIF 2992 ENDIF 2993 ! 2994 !-- Read chemistry variables. 2995 !-- Please note, for the moment, only LOD=1 is allowed 2996 IF ( air_chemistry ) THEN 2997 ! 2998 !-- Allocate chemistry input profiles, as well as arrays for fill values 2999 !-- and LOD's. 3000 ALLOCATE( init_3d%chem_init(nzb:nzt+1, & 3001 1:UBOUND(init_3d%var_names_chem, 1 )) ) 3002 ALLOCATE( init_3d%fill_chem(1:UBOUND(init_3d%var_names_chem, 1)) ) 3003 ALLOCATE( init_3d%lod_chem(1:UBOUND(init_3d%var_names_chem, 1)) ) 3004 3005 DO n = 1, UBOUND(init_3d%var_names_chem, 1) 3006 IF ( check_existence( var_names, & 3007 TRIM( init_3d%var_names_chem(n) ) ) ) THEN 3008 ! 3009 !-- Read attributes for the fill value and level-of-detail 3010 CALL get_attribute( id_dynamic, char_fill, & 3011 init_3d%fill_chem(n), & 3012 .FALSE., & 3013 TRIM( init_3d%var_names_chem(n) ) ) 3014 CALL get_attribute( id_dynamic, char_lod, & 3015 init_3d%lod_chem(n), & 3016 .FALSE., & 3017 TRIM( init_3d%var_names_chem(n) ) ) 3018 ! 3019 !-- Give message that only LOD=1 is allowed. 3020 IF ( init_3d%lod_chem(n) /= 1 ) THEN 3021 message_string = 'For chemistry variables only LOD=1 is ' //& 3022 'allowed.' 3023 CALL message( 'netcdf_data_input_mod', 'PA0586', & 3024 1, 2, 0, 6, 0 ) 3025 ENDIF 3026 ! 3027 !-- level-of-detail 1 - read initialization profile 3028 CALL get_variable( id_dynamic, & 3029 TRIM( init_3d%var_names_chem(n) ), & 3030 init_3d%chem_init(nzb+1:nzt,n) ) 3031 ! 3032 !-- Set bottom and top boundary condition (Neumann) 3033 init_3d%chem_init(nzb,n) = init_3d%chem_init(nzb+1,n) 3034 init_3d%chem_init(nzt+1,n) = init_3d%chem_init(nzt,n) 3035 3036 init_3d%from_file_chem(n) = .TRUE. 3037 ENDIF 3038 ENDDO 2769 ENDIF 2770 2771 IF ( init_3d%from_file_v ) THEN 2772 check_passed = .TRUE. 2773 IF ( init_3d%lod_v == 1 ) THEN 2774 IF ( ANY( init_3d%v_init(nzb+1:nzt+1) == init_3d%fill_v ) ) check_passed = .FALSE. 2775 ELSEIF ( init_3d%lod_v == 2 ) THEN 2776 IF ( ANY( v(nzb+1:nzt+1,nysv:nyn,nxl:nxr) == init_3d%fill_v ) ) check_passed = .FALSE. 3039 2777 ENDIF 3040 ! 3041 !-- Close input file 3042 CALL close_input_file( id_dynamic ) 3043 #endif 3044 ! 3045 !-- End of CPU measurement 3046 CALL cpu_log( log_point_s(85), 'NetCDF input init', 'stop' ) 3047 ! 3048 !-- Finally, check if the input data has any fill values. Please note, 3049 !-- checks depend on the LOD of the input data. 3050 IF ( init_3d%from_file_u ) THEN 3051 check_passed = .TRUE. 3052 IF ( init_3d%lod_u == 1 ) THEN 3053 IF ( ANY( init_3d%u_init(nzb+1:nzt+1) == init_3d%fill_u ) ) & 3054 check_passed = .FALSE. 3055 ELSEIF ( init_3d%lod_u == 2 ) THEN 3056 IF ( ANY( u(nzb+1:nzt+1,nys:nyn,nxlu:nxr) == init_3d%fill_u ) ) & 3057 check_passed = .FALSE. 3058 ENDIF 3059 IF ( .NOT. check_passed ) THEN 3060 message_string = 'NetCDF input for init_atmosphere_u must ' // & 3061 'not contain any _FillValues' 3062 CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 ) 3063 ENDIF 2778 IF ( .NOT. check_passed ) THEN 2779 message_string = 'NetCDF input for init_atmosphere_v must ' // & 2780 'not contain any _FillValues' 2781 CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 ) 3064 2782 ENDIF 3065 3066 IF ( init_3d%from_file_v ) THEN 3067 check_passed = .TRUE. 3068 IF ( init_3d%lod_v == 1 ) THEN 3069 IF ( ANY( init_3d%v_init(nzb+1:nzt+1) == init_3d%fill_v ) ) & 3070 check_passed = .FALSE. 3071 ELSEIF ( init_3d%lod_v == 2 ) THEN 3072 IF ( ANY( v(nzb+1:nzt+1,nysv:nyn,nxl:nxr) == init_3d%fill_v ) ) & 3073 check_passed = .FALSE. 3074 ENDIF 3075 IF ( .NOT. check_passed ) THEN 3076 message_string = 'NetCDF input for init_atmosphere_v must ' // & 3077 'not contain any _FillValues' 3078 CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 ) 3079 ENDIF 2783 ENDIF 2784 2785 IF ( init_3d%from_file_w ) THEN 2786 check_passed = .TRUE. 2787 IF ( init_3d%lod_w == 1 ) THEN 2788 IF ( ANY( init_3d%w_init(nzb+1:nzt) == init_3d%fill_w ) ) check_passed = .FALSE. 2789 ELSEIF ( init_3d%lod_w == 2 ) THEN 2790 IF ( ANY( w(nzb+1:nzt,nys:nyn,nxl:nxr) == init_3d%fill_w ) ) check_passed = .FALSE. 3080 2791 ENDIF 3081 3082 IF ( init_3d%from_file_w ) THEN 3083 check_passed = .TRUE. 3084 IF ( init_3d%lod_w == 1 ) THEN 3085 IF ( ANY( init_3d%w_init(nzb+1:nzt) == init_3d%fill_w ) ) & 3086 check_passed = .FALSE. 3087 ELSEIF ( init_3d%lod_w == 2 ) THEN 3088 IF ( ANY( w(nzb+1:nzt,nys:nyn,nxl:nxr) == init_3d%fill_w ) ) & 3089 check_passed = .FALSE. 3090 ENDIF 3091 IF ( .NOT. check_passed ) THEN 3092 message_string = 'NetCDF input for init_atmosphere_w must ' // & 3093 'not contain any _FillValues' 3094 CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 ) 3095 ENDIF 2792 IF ( .NOT. check_passed ) THEN 2793 message_string = 'NetCDF input for init_atmosphere_w must ' // & 2794 'not contain any _FillValues' 2795 CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 ) 3096 2796 ENDIF 3097 3098 IF ( init_3d%from_file_pt ) THEN 3099 check_passed = .TRUE. 3100 IF ( init_3d%lod_pt == 1 ) THEN 3101 IF ( ANY( init_3d%pt_init(nzb+1:nzt+1) == init_3d%fill_pt ) ) & 3102 check_passed = .FALSE. 3103 ELSEIF ( init_3d%lod_pt == 2 ) THEN 3104 IF ( ANY( pt(nzb+1:nzt+1,nys:nyn,nxl:nxr) == init_3d%fill_pt ) ) & 3105 check_passed = .FALSE. 3106 ENDIF 3107 IF ( .NOT. check_passed ) THEN 3108 message_string = 'NetCDF input for init_atmosphere_pt must ' // & 3109 'not contain any _FillValues' 3110 CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 ) 3111 ENDIF 2797 ENDIF 2798 2799 IF ( init_3d%from_file_pt ) THEN 2800 check_passed = .TRUE. 2801 IF ( init_3d%lod_pt == 1 ) THEN 2802 IF ( ANY( init_3d%pt_init(nzb+1:nzt+1) == init_3d%fill_pt ) ) check_passed = .FALSE. 2803 ELSEIF ( init_3d%lod_pt == 2 ) THEN 2804 IF ( ANY( pt(nzb+1:nzt+1,nys:nyn,nxl:nxr) == init_3d%fill_pt ) ) check_passed = .FALSE. 3112 2805 ENDIF 3113 3114 IF ( init_3d%from_file_q ) THEN 3115 check_passed = .TRUE. 3116 IF ( init_3d%lod_q == 1 ) THEN 3117 IF ( ANY( init_3d%q_init(nzb+1:nzt+1) == init_3d%fill_q ) ) & 3118 check_passed = .FALSE. 3119 ELSEIF ( init_3d%lod_q == 2 ) THEN 3120 IF ( ANY( q(nzb+1:nzt+1,nys:nyn,nxl:nxr) == init_3d%fill_q ) ) & 3121 check_passed = .FALSE. 3122 ENDIF 3123 IF ( .NOT. check_passed ) THEN 3124 message_string = 'NetCDF input for init_atmosphere_q must ' // & 3125 'not contain any _FillValues' 3126 CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 ) 3127 ENDIF 2806 IF ( .NOT. check_passed ) THEN 2807 message_string = 'NetCDF input for init_atmosphere_pt must ' // & 2808 'not contain any _FillValues' 2809 CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 ) 3128 2810 ENDIF 3129 ! 3130 !-- Workaround for cyclic conditions. Please see above for further explanation. 3131 IF ( bc_lr_cyc .AND. nxl == 0 ) nxlu = nxl 3132 IF ( bc_ns_cyc .AND. nys == 0 ) nysv = nys 3133 3134 END SUBROUTINE netcdf_data_input_init_3d 3135 3136 !------------------------------------------------------------------------------! 2811 ENDIF 2812 2813 IF ( init_3d%from_file_q ) THEN 2814 check_passed = .TRUE. 2815 IF ( init_3d%lod_q == 1 ) THEN 2816 IF ( ANY( init_3d%q_init(nzb+1:nzt+1) == init_3d%fill_q ) ) check_passed = .FALSE. 2817 ELSEIF ( init_3d%lod_q == 2 ) THEN 2818 IF ( ANY( q(nzb+1:nzt+1,nys:nyn,nxl:nxr) == init_3d%fill_q ) ) check_passed = .FALSE. 2819 ENDIF 2820 IF ( .NOT. check_passed ) THEN 2821 message_string = 'NetCDF input for init_atmosphere_q must ' // & 2822 'not contain any _FillValues' 2823 CALL message( 'netcdf_data_input_mod', 'PA0545', 2, 2, 0, 6, 0 ) 2824 ENDIF 2825 ENDIF 2826 ! 2827 !-- Workaround for cyclic conditions. Please see above for further explanation. 2828 IF ( bc_lr_cyc .AND. nxl == 0 ) nxlu = nxl 2829 IF ( bc_ns_cyc .AND. nys == 0 ) nysv = nys 2830 2831 END SUBROUTINE netcdf_data_input_init_3d 2832 2833 2834 !--------------------------------------------------------------------------------------------------! 3137 2835 ! Description: 3138 2836 ! ------------ 3139 2837 !> Checks input file for consistency and minimum requirements. 3140 !------------------------------------------------------------------------------! 3141 SUBROUTINE netcdf_data_input_check_dynamic 3142 3143 USE control_parameters, & 3144 ONLY: initializing_actions, message_string 3145 3146 IMPLICIT NONE 3147 ! 3148 !-- Dynamic input file must also be present if initialization via inifor is 3149 !-- prescribed. 3150 IF ( .NOT. input_pids_dynamic .AND. & 3151 INDEX( initializing_actions, 'inifor' ) /= 0 ) THEN 3152 message_string = 'initializing_actions = inifor requires dynamic ' //& 3153 'input file ' // TRIM( input_file_dynamic ) // & 3154 TRIM( coupling_char ) 3155 CALL message( 'netcdf_data_input_mod', 'PA0547', 1, 2, 0, 6, 0 ) 3156 ENDIF 3157 3158 END SUBROUTINE netcdf_data_input_check_dynamic 3159 3160 !------------------------------------------------------------------------------! 2838 !--------------------------------------------------------------------------------------------------! 2839 SUBROUTINE netcdf_data_input_check_dynamic 2840 2841 USE control_parameters, & 2842 ONLY: initializing_actions, message_string 2843 2844 IMPLICIT NONE 2845 ! 2846 !-- Dynamic input file must also be present if initialization via inifor is prescribed. 2847 IF ( .NOT. input_pids_dynamic .AND. INDEX( initializing_actions, 'inifor' ) /= 0 ) THEN 2848 message_string = 'initializing_actions = inifor requires dynamic ' // & 2849 'input file ' // TRIM( input_file_dynamic ) // TRIM( coupling_char ) 2850 CALL message( 'netcdf_data_input_mod', 'PA0547', 1, 2, 0, 6, 0 ) 2851 ENDIF 2852 2853 END SUBROUTINE netcdf_data_input_check_dynamic 2854 2855 2856 !--------------------------------------------------------------------------------------------------! 3161 2857 ! Description: 3162 2858 ! ------------ 3163 2859 !> Checks input file for consistency and minimum requirements. 3164 !------------------------------------------------------------------------------! 3165 SUBROUTINE netcdf_data_input_check_static 3166 3167 USE arrays_3d, & 3168 ONLY: zu 3169 3170 USE control_parameters, & 3171 ONLY: land_surface, message_string, urban_surface 3172 3173 USE indices, & 3174 ONLY: nxl, nxr, nyn, nys, wall_flags_total_0 3175 3176 IMPLICIT NONE 3177 3178 INTEGER(iwp) :: i !< loop index along x-direction 3179 INTEGER(iwp) :: j !< loop index along y-direction 3180 INTEGER(iwp) :: n_surf !< number of different surface types at given location 3181 3182 LOGICAL :: check_passed !< flag indicating if a check passed 3183 3184 ! 3185 !-- Return if no static input file is available 3186 IF ( .NOT. input_pids_static ) RETURN 3187 ! 3188 !-- Check for correct dimension of surface_fractions, should run from 0-2. 3189 IF ( surface_fraction_f%from_file ) THEN 3190 IF ( surface_fraction_f%nf-1 > 2 ) THEN 3191 message_string = 'nsurface_fraction must not be larger than 3.' 3192 CALL message( 'netcdf_data_input_mod', 'PA0580', 1, 2, 0, 6, 0 ) 2860 !--------------------------------------------------------------------------------------------------! 2861 SUBROUTINE netcdf_data_input_check_static 2862 2863 USE arrays_3d, & 2864 ONLY: zu 2865 2866 USE control_parameters, & 2867 ONLY: land_surface, message_string, urban_surface 2868 2869 USE indices, & 2870 ONLY: nxl, nxr, nyn, nys, wall_flags_total_0 2871 2872 IMPLICIT NONE 2873 2874 INTEGER(iwp) :: i !< loop index along x-direction 2875 INTEGER(iwp) :: j !< loop index along y-direction 2876 INTEGER(iwp) :: n_surf !< number of different surface types at given location 2877 2878 LOGICAL :: check_passed !< flag indicating if a check passed 2879 2880 ! 2881 !-- Return if no static input file is available 2882 IF ( .NOT. input_pids_static ) RETURN 2883 ! 2884 !-- Check for correct dimension of surface_fractions, should run from 0-2. 2885 IF ( surface_fraction_f%from_file ) THEN 2886 IF ( surface_fraction_f%nf-1 > 2 ) THEN 2887 message_string = 'nsurface_fraction must not be larger than 3.' 2888 CALL message( 'netcdf_data_input_mod', 'PA0580', 1, 2, 0, 6, 0 ) 2889 ENDIF 2890 ENDIF 2891 ! 2892 !-- If 3D buildings are read, check if building information is consistent to numeric grid. 2893 IF ( buildings_f%from_file ) THEN 2894 IF ( buildings_f%lod == 2 ) THEN 2895 IF ( buildings_f%nz > SIZE( zu ) ) THEN 2896 message_string = 'Reading 3D building data - too much ' // & 2897 'data points along the vertical coordinate.' 2898 CALL message( 'netcdf_data_input_mod', 'PA0552', 2, 2, 0, 6, 0 ) 2899 ENDIF 2900 2901 IF ( ANY( ABS( buildings_f%z(0:buildings_f%nz-1) - zu(0:buildings_f%nz-1) ) > 1E-6_wp ) )& 2902 THEN 2903 message_string = 'Reading 3D building data - vertical ' // & 2904 'coordinate do not match numeric grid.' 2905 CALL message( 'netcdf_data_input_mod', 'PA0553', 2, 2, 0, 6, 0 ) 3193 2906 ENDIF 3194 2907 ENDIF 3195 ! 3196 !-- If 3D buildings are read, check if building information is consistent 3197 !-- to numeric grid. 3198 IF ( buildings_f%from_file ) THEN 3199 IF ( buildings_f%lod == 2 ) THEN 3200 IF ( buildings_f%nz > SIZE( zu ) ) THEN 3201 message_string = 'Reading 3D building data - too much ' // & 3202 'data points along the vertical coordinate.' 3203 CALL message( 'netcdf_data_input_mod', 'PA0552', 2, 2, 0, 6, 0 ) 2908 ENDIF 2909 2910 ! 2911 !-- Skip further checks concerning buildings and natural surface properties if no urban surface and 2912 !-- land surface model are applied. 2913 IF ( .NOT. land_surface .AND. .NOT. urban_surface ) RETURN 2914 ! 2915 !-- Check for minimum requirement of surface-classification data in case static input file is used. 2916 IF ( ( .NOT. vegetation_type_f%from_file .OR. & 2917 .NOT. pavement_type_f%from_file .OR. & 2918 .NOT. water_type_f%from_file .OR. & 2919 .NOT. soil_type_f%from_file ) .OR. & 2920 ( urban_surface .AND. .NOT. building_type_f%from_file ) ) THEN 2921 message_string = 'Minimum requirement for surface classification is not fulfilled. At ' // & 2922 'least vegetation_type, pavement_type, soil_type and water_type are ' // & 2923 'required. If urban-surface model is applied, also building_type is required' 2924 CALL message( 'netcdf_data_input_mod', 'PA0554', 1, 2, 0, 6, 0 ) 2925 ENDIF 2926 ! 2927 !-- Check for general availability of input variables. 2928 !-- If vegetation_type is 0 at any location, vegetation_pars as well as root_area_dens_s are 2929 !-- required. 2930 IF ( vegetation_type_f%from_file ) THEN 2931 IF ( ANY( vegetation_type_f%var == 0 ) ) THEN 2932 IF ( .NOT. vegetation_pars_f%from_file ) THEN 2933 message_string = 'If vegetation_type = 0 at any location, ' // & 2934 'vegetation_pars is required' 2935 CALL message( 'netcdf_data_input_mod', 'PA0555', 2, 2, myid, 6, 0 ) 2936 ENDIF 2937 IF ( .NOT. root_area_density_lsm_f%from_file ) THEN 2938 message_string = 'If vegetation_type = 0 at any location, ' // & 2939 'root_area_dens_s is required' 2940 CALL message( 'netcdf_data_input_mod', 'PA0556', 2, 2, myid, 6, 0 ) 2941 ENDIF 2942 ENDIF 2943 ENDIF 2944 ! 2945 !-- If soil_type is zero at any location, soil_pars is required. 2946 IF ( soil_type_f%from_file ) THEN 2947 check_passed = .TRUE. 2948 IF ( ALLOCATED( soil_type_f%var_2d ) ) THEN 2949 IF ( ANY( soil_type_f%var_2d == 0 ) ) THEN 2950 IF ( .NOT. soil_pars_f%from_file ) check_passed = .FALSE. 2951 ENDIF 2952 ELSE 2953 IF ( ANY( soil_type_f%var_3d == 0 ) ) THEN 2954 IF ( .NOT. soil_pars_f%from_file ) check_passed = .FALSE. 2955 ENDIF 2956 ENDIF 2957 IF ( .NOT. check_passed ) THEN 2958 message_string = 'If soil_type = 0 at any location, soil_pars is required' 2959 CALL message( 'netcdf_data_input_mod', 'PA0557', 2, 2, myid, 6, 0 ) 2960 ENDIF 2961 ENDIF 2962 ! 2963 !-- Buildings require a type in case of urban-surface model. 2964 IF ( buildings_f%from_file .AND. .NOT. building_type_f%from_file ) THEN 2965 message_string = 'If buildings are provided, also building_type is required' 2966 CALL message( 'netcdf_data_input_mod', 'PA0581', 2, 2, 0, 6, 0 ) 2967 ENDIF 2968 ! 2969 !-- Buildings require an ID. 2970 IF ( buildings_f%from_file .AND. .NOT. building_id_f%from_file ) THEN 2971 message_string = 'If buildings are provided, also building_id is required' 2972 CALL message( 'netcdf_data_input_mod', 'PA0582', 2, 2, 0, 6, 0 ) 2973 ENDIF 2974 ! 2975 !-- If building_type is zero at any location, building_pars is required. 2976 IF ( building_type_f%from_file ) THEN 2977 IF ( ANY( building_type_f%var == 0 ) ) THEN 2978 IF ( .NOT. building_pars_f%from_file ) THEN 2979 message_string = 'If building_type = 0 at any location, ' // & 2980 'building_pars is required' 2981 CALL message( 'netcdf_data_input_mod', 'PA0558', 2, 2, myid, 6, 0 ) 2982 ENDIF 2983 ENDIF 2984 ENDIF 2985 ! 2986 !-- If building_type is provided, also building_id is needed (due to the filtering algorithm). 2987 IF ( building_type_f%from_file .AND. .NOT. building_id_f%from_file ) THEN 2988 message_string = 'If building_type is provided, also building_id is required' 2989 CALL message( 'netcdf_data_input_mod', 'PA0519', 2, 2, 0, 6, 0 ) 2990 ENDIF 2991 ! 2992 !-- If albedo_type is zero at any location, albedo_pars is required. 2993 IF ( albedo_type_f%from_file ) THEN 2994 IF ( ANY( albedo_type_f%var == 0 ) ) THEN 2995 IF ( .NOT. albedo_pars_f%from_file ) THEN 2996 message_string = 'If albedo_type = 0 at any location, albedo_pars is required' 2997 CALL message( 'netcdf_data_input_mod', 'PA0559', 2, 2, myid, 6, 0 ) 2998 ENDIF 2999 ENDIF 3000 ENDIF 3001 ! 3002 !-- If pavement_type is zero at any location, pavement_pars is required. 3003 IF ( pavement_type_f%from_file ) THEN 3004 IF ( ANY( pavement_type_f%var == 0 ) ) THEN 3005 IF ( .NOT. pavement_pars_f%from_file ) THEN 3006 message_string = 'If pavement_type = 0 at any location, pavement_pars is required' 3007 CALL message( 'netcdf_data_input_mod', 'PA0560', 2, 2, myid, 6, 0 ) 3008 ENDIF 3009 ENDIF 3010 ENDIF 3011 ! 3012 !-- If pavement_type is zero at any location, also pavement_subsurface_pars is required. 3013 IF ( pavement_type_f%from_file ) THEN 3014 IF ( ANY( pavement_type_f%var == 0 ) ) THEN 3015 IF ( .NOT. pavement_subsurface_pars_f%from_file ) THEN 3016 message_string = 'If pavement_type = 0 at any location, ' // & 3017 'pavement_subsurface_pars is required' 3018 CALL message( 'netcdf_data_input_mod', 'PA0561', 2, 2, myid, 6, 0 ) 3019 ENDIF 3020 ENDIF 3021 ENDIF 3022 ! 3023 !-- If water_type is zero at any location, water_pars is required. 3024 IF ( water_type_f%from_file ) THEN 3025 IF ( ANY( water_type_f%var == 0 ) ) THEN 3026 IF ( .NOT. water_pars_f%from_file ) THEN 3027 message_string = 'If water_type = 0 at any location, water_pars is required' 3028 CALL message( 'netcdf_data_input_mod', 'PA0562', 2, 2, myid, 6, 0 ) 3029 ENDIF 3030 ENDIF 3031 ENDIF 3032 ! 3033 !-- Check for local consistency of the input data. 3034 DO i = nxl, nxr 3035 DO j = nys, nyn 3036 ! 3037 !-- For each (y,x)-location at least one of the parameters vegetation_type, pavement_type, 3038 !-- building_type, or water_type must be set to a nonÂmissing value. 3039 IF ( land_surface .AND. .NOT. urban_surface ) THEN 3040 IF ( vegetation_type_f%var(j,i) == vegetation_type_f%fill .AND. & 3041 pavement_type_f%var(j,i) == pavement_type_f%fill .AND. & 3042 water_type_f%var(j,i) == water_type_f%fill ) THEN 3043 WRITE( message_string, * ) 'At least one of the parameters '// & 3044 'vegetation_type, pavement_type, ' // & 3045 'or water_type must be set '// & 3046 'to a non-missing value. Grid point: ', j, i 3047 CALL message( 'netcdf_data_input_mod', 'PA0563', 2, 2, myid, 6, 0 ) 3204 3048 ENDIF 3205 3206 IF ( ANY( ABS( buildings_f%z(0:buildings_f%nz-1) - & 3207 zu(0:buildings_f%nz-1) ) > 1E-6_wp ) ) THEN 3208 message_string = 'Reading 3D building data - vertical ' // & 3209 'coordinate do not match numeric grid.' 3210 CALL message( 'netcdf_data_input_mod', 'PA0553', 2, 2, 0, 6, 0 ) 3049 ELSEIF ( land_surface .AND. urban_surface ) THEN 3050 IF ( vegetation_type_f%var(j,i) == vegetation_type_f%fill .AND. & 3051 pavement_type_f%var(j,i) == pavement_type_f%fill .AND. & 3052 building_type_f%var(j,i) == building_type_f%fill .AND. & 3053 water_type_f%var(j,i) == water_type_f%fill ) THEN 3054 WRITE( message_string, * ) 'At least one of the parameters '// & 3055 'vegetation_type, pavement_type, ' // & 3056 'building_type, or water_type must be set '// & 3057 'to a non-missing value. Grid point: ', j, i 3058 CALL message( 'netcdf_data_input_mod', 'PA0563', 2, 2, myid, 6, 0 ) 3211 3059 ENDIF 3212 3060 ENDIF 3213 ENDIF 3214 3215 ! 3216 !-- Skip further checks concerning buildings and natural surface properties 3217 !-- if no urban surface and land surface model are applied. 3218 IF ( .NOT. land_surface .AND. .NOT. urban_surface ) RETURN 3219 ! 3220 !-- Check for minimum requirement of surface-classification data in case 3221 !-- static input file is used. 3222 IF ( ( .NOT. vegetation_type_f%from_file .OR. & 3223 .NOT. pavement_type_f%from_file .OR. & 3224 .NOT. water_type_f%from_file .OR. & 3225 .NOT. soil_type_f%from_file ) .OR. & 3226 ( urban_surface .AND. .NOT. building_type_f%from_file ) ) THEN 3227 message_string = 'Minimum requirement for surface classification ' //& 3228 'is not fulfilled. At least ' // & 3229 'vegetation_type, pavement_type, ' // & 3230 'soil_type and water_type are '// & 3231 'required. If urban-surface model is applied, ' // & 3232 'also building_type is required' 3233 CALL message( 'netcdf_data_input_mod', 'PA0554', 1, 2, 0, 6, 0 ) 3234 ENDIF 3235 ! 3236 !-- Check for general availability of input variables. 3237 !-- If vegetation_type is 0 at any location, vegetation_pars as well as 3238 !-- root_area_dens_s are required. 3239 IF ( vegetation_type_f%from_file ) THEN 3240 IF ( ANY( vegetation_type_f%var == 0 ) ) THEN 3241 IF ( .NOT. vegetation_pars_f%from_file ) THEN 3242 message_string = 'If vegetation_type = 0 at any location, ' // & 3243 'vegetation_pars is required' 3244 CALL message( 'netcdf_data_input_mod', 'PA0555', 2, 2, myid, 6, 0 ) 3061 3062 ! 3063 !-- Note that a soil_type is required for each location (y,x) where either vegetation_type or 3064 !-- pavement_type is a nonÂmissing value. 3065 IF ( ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill .OR. & 3066 pavement_type_f%var(j,i) /= pavement_type_f%fill ) ) THEN 3067 check_passed = .TRUE. 3068 IF ( ALLOCATED( soil_type_f%var_2d ) ) THEN 3069 IF ( soil_type_f%var_2d(j,i) == soil_type_f%fill ) check_passed = .FALSE. 3070 ELSE 3071 IF ( ANY( soil_type_f%var_3d(:,j,i) == soil_type_f%fill) ) check_passed = .FALSE. 3245 3072 ENDIF 3246 IF ( .NOT. root_area_density_lsm_f%from_file ) THEN 3247 message_string = 'If vegetation_type = 0 at any location, ' // & 3248 'root_area_dens_s is required' 3249 CALL message( 'netcdf_data_input_mod', 'PA0556', 2, 2, myid, 6, 0 ) 3073 3074 IF ( .NOT. check_passed ) THEN 3075 message_string = 'soil_type is required for each '// & 3076 'location (y,x) where vegetation_type or ' // & 3077 'pavement_type is a non-missing value.' 3078 CALL message( 'netcdf_data_input_mod', 'PA0564', 2, 2, myid, 6, 0 ) 3250 3079 ENDIF 3251 3080 ENDIF 3252 ENDIF 3253 ! 3254 !-- If soil_type is zero at any location, soil_pars is required. 3255 IF ( soil_type_f%from_file ) THEN 3256 check_passed = .TRUE. 3257 IF ( ALLOCATED( soil_type_f%var_2d ) ) THEN 3258 IF ( ANY( soil_type_f%var_2d == 0 ) ) THEN 3259 IF ( .NOT. soil_pars_f%from_file ) check_passed = .FALSE. 3081 ! 3082 !-- Check for consistency of given types. At the moment, only one of vegetation, pavement, or 3083 !-- water-type can be set. This is because no tile approach is yet implemented in the 3084 !-- land-surface model. Later, when this is possible, surface fraction needs to be given and 3085 !-- the sum must not be larger than 1. Please note, in case more than one type is given at a 3086 !-- pixel, an error message will be given. 3087 n_surf = 0 3088 IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill ) n_surf = n_surf + 1 3089 IF ( water_type_f%var(j,i) /= water_type_f%fill ) n_surf = n_surf + 1 3090 IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill ) n_surf = n_surf + 1 3091 3092 IF ( n_surf > 1 ) THEN 3093 WRITE( message_string, * ) 'More than one surface type (vegetation, ' // & 3094 'pavement, water) is given at a location. ' // & 3095 'Please note, this is not possible at ' // & 3096 'the moment as no tile approach has been ' // & 3097 'yet implemented. (i,j) = ', i, j 3098 CALL message( 'netcdf_data_input_mod', 'PA0565', & 3099 2, 2, myid, 6, 0 ) 3100 3101 ! IF ( .NOT. surface_fraction_f%from_file ) THEN 3102 ! message_string = 'More than one surface type (vegetation '// & 3103 ! 'pavement, water) is given at a location. '// & 3104 ! 'Please note, this is not possible at ' // & 3105 ! 'the moment as no tile approach is yet ' // & 3106 ! 'implemented.' 3107 ! message_string = 'If more than one surface type is ' // & 3108 ! 'given at a location, surface_fraction ' // & 3109 ! 'must be provided.' 3110 ! CALL message( 'netcdf_data_input_mod', 'PA0565', 2, 2, myid, 6, 0 ) 3111 ! ELSEIF ( ANY ( surface_fraction_f%frac(:,j,i) == surface_fraction_f%fill ) ) THEN 3112 ! message_string = 'If more than one surface type is ' // & 3113 ! 'given at a location, surface_fraction ' // & 3114 ! 'must be provided.' 3115 ! CALL message( 'netcdf_data_input_mod', 'PA0565', 2, 2, myid, 6, 0 ) 3116 ! ENDIF 3117 ENDIF 3118 ! 3119 !-- Check for further mismatches. e.g. relative fractions exceed 1 or vegetation_type is set 3120 !-- but surface vegetation fraction is zero, etc.. 3121 IF ( surface_fraction_f%from_file ) THEN 3122 ! 3123 !-- If surface fractions is given, also check that only one type is given. 3124 IF ( SUM( MERGE( 1, 0, surface_fraction_f%frac(:,j,i) /= 0.0_wp .AND. & 3125 surface_fraction_f%frac(:,j,i) /= surface_fraction_f%fill ) & 3126 ) > 1 ) & 3127 THEN 3128 WRITE( message_string, * ) 'surface_fraction is given for more ' // & 3129 'than one type. ' // & 3130 'Please note, this is not possible at ' // & 3131 'the moment as no tile approach has ' // & 3132 'yet been implemented. (i, j) = ', i, j 3133 CALL message( 'netcdf_data_input_mod', 'PA0676', 2, 2, myid, 6, 0 ) 3260 3134 ENDIF 3261 ELSE 3262 IF ( ANY( soil_type_f%var_3d == 0 ) ) THEN 3263 IF ( .NOT. soil_pars_f%from_file ) check_passed = .FALSE. 3135 ! 3136 !-- Sum of relative fractions must be 1. Note, attributed to type conversions due to 3137 !-- reading, the sum of surface fractions might be not exactly 1. Hence, the sum is check 3138 !-- with a tolerance. Later, in the land-surface model, the relative fractions are 3139 !-- normalized to one. Actually, surface fractions shall be _FillValue at building grid 3140 !-- points, however, in order to relax this requirement and allow that surface-fraction can 3141 !-- also be zero at these grid points, only perform this check at locations where some 3142 !-- vegetation, pavement or water is defined. 3143 IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill .OR. & 3144 pavement_type_f%var(j,i) /= pavement_type_f%fill .OR. & 3145 water_type_f%var(j,i) /= water_type_f%fill ) THEN 3146 IF ( SUM ( surface_fraction_f%frac(0:2,j,i) ) > 1.0_wp + 1E-8_wp .OR. & 3147 SUM ( surface_fraction_f%frac(0:2,j,i) ) < 1.0_wp - 1E-8_wp ) THEN 3148 WRITE( message_string, * ) 'The sum of all land-surface fractions ' // & 3149 'must equal 1. (i, j) = ', i, j 3150 CALL message( 'netcdf_data_input_mod', 'PA0566', 2, 2, myid, 6, 0 ) 3151 ENDIF 3152 ENDIF 3153 ! 3154 !-- Relative fraction for a type must not be zero at locations where this type is set. 3155 IF ( ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill .AND. & 3156 ( surface_fraction_f%frac(ind_veg_wall,j,i) == 0.0_wp .OR. & 3157 surface_fraction_f%frac(ind_veg_wall,j,i) == surface_fraction_f%fill ) & 3158 ) .OR. & 3159 ( pavement_type_f%var(j,i) /= pavement_type_f%fill .AND. & 3160 ( surface_fraction_f%frac(ind_pav_green,j,i) == 0.0_wp .OR. & 3161 surface_fraction_f%frac(ind_pav_green,j,i) == surface_fraction_f%fill ) & 3162 ) .OR. & 3163 ( water_type_f%var(j,i) /= water_type_f%fill .AND. & 3164 ( surface_fraction_f%frac(ind_wat_win,j,i) == 0.0_wp .OR. & 3165 surface_fraction_f%frac(ind_wat_win,j,i) == surface_fraction_f%fill ) & 3166 ) ) THEN 3167 WRITE( message_string, * ) 'Mismatch in setting of ' // & 3168 'surface_fraction. Vegetation-, pavement-, or ' // & 3169 'water surface is given at (i,j) = ( ', i, j, & 3170 ' ), but surface fraction is 0 for the given type.' 3171 CALL message( 'netcdf_data_input_mod', 'PA0567', 2, 2, myid, 6, 0 ) 3172 ENDIF 3173 ! 3174 !-- Relative fraction for a type must not contain non-zero values if this type is not set. 3175 IF ( ( vegetation_type_f%var(j,i) == vegetation_type_f%fill .AND. & 3176 ( surface_fraction_f%frac(ind_veg_wall,j,i) /= 0.0_wp .AND. & 3177 surface_fraction_f%frac(ind_veg_wall,j,i) /= surface_fraction_f%fill ) & 3178 ) .OR. & 3179 ( pavement_type_f%var(j,i) == pavement_type_f%fill .AND. & 3180 ( surface_fraction_f%frac(ind_pav_green,j,i) /= 0.0_wp .AND. & 3181 surface_fraction_f%frac(ind_pav_green,j,i) /= surface_fraction_f%fill ) & 3182 ) .OR. & 3183 ( water_type_f%var(j,i) == water_type_f%fill .AND. & 3184 ( surface_fraction_f%frac(ind_wat_win,j,i) /= 0.0_wp .AND. & 3185 surface_fraction_f%frac(ind_wat_win,j,i) /= surface_fraction_f%fill ) & 3186 ) ) THEN 3187 WRITE( message_string, * ) 'Mismatch in setting of ' // & 3188 'surface_fraction. Vegetation-, pavement-, or '// & 3189 'water surface is not given at (i,j) = ( ', i, j, & 3190 ' ), but surface fraction is not 0 for the ' // & 3191 'given type.' 3192 CALL message( 'netcdf_data_input_mod', 'PA0568', 2, 2, myid, 6, 0 ) 3264 3193 ENDIF 3265 3194 ENDIF 3266 IF ( .NOT. check_passed ) THEN 3267 message_string = 'If soil_type = 0 at any location, ' // & 3268 'soil_pars is required' 3269 CALL message( 'netcdf_data_input_mod', 'PA0557', 2, 2, myid, 6, 0 ) 3270 ENDIF 3271 ENDIF 3272 ! 3273 !-- Buildings require a type in case of urban-surface model. 3274 IF ( buildings_f%from_file .AND. .NOT. building_type_f%from_file ) THEN 3275 message_string = 'If buildings are provided, also building_type ' // & 3276 'is required' 3277 CALL message( 'netcdf_data_input_mod', 'PA0581', 2, 2, 0, 6, 0 ) 3278 ENDIF 3279 ! 3280 !-- Buildings require an ID. 3281 IF ( buildings_f%from_file .AND. .NOT. building_id_f%from_file ) THEN 3282 message_string = 'If buildings are provided, also building_id ' // & 3283 'is required' 3284 CALL message( 'netcdf_data_input_mod', 'PA0582', 2, 2, 0, 6, 0 ) 3285 ENDIF 3286 ! 3287 !-- If building_type is zero at any location, building_pars is required. 3288 IF ( building_type_f%from_file ) THEN 3289 IF ( ANY( building_type_f%var == 0 ) ) THEN 3290 IF ( .NOT. building_pars_f%from_file ) THEN 3291 message_string = 'If building_type = 0 at any location, ' // & 3292 'building_pars is required' 3293 CALL message( 'netcdf_data_input_mod', 'PA0558', 2, 2, myid, 6, 0 ) 3195 ! 3196 !-- Check vegetation_pars. If vegetation_type is 0, all parameters need to be set, otherwise, 3197 !-- single parameters set by vegetation_type can be overwritten. 3198 IF ( vegetation_type_f%from_file ) THEN 3199 IF ( vegetation_type_f%var(j,i) == 0 ) THEN 3200 IF ( ANY( vegetation_pars_f%pars_xy(:,j,i) == vegetation_pars_f%fill ) ) THEN 3201 message_string = 'If vegetation_type(y,x) = 0, all ' // & 3202 'parameters of vegetation_pars at ' // & 3203 'this location must be set.' 3204 CALL message( 'netcdf_data_input_mod', 'PA0569', 2, 2, myid, 6, 0 ) 3205 ENDIF 3294 3206 ENDIF 3295 3207 ENDIF 3296 ENDIF 3297 ! 3298 !-- If building_type is provided, also building_id is needed (due to the 3299 !-- filtering algorithm). 3300 IF ( building_type_f%from_file .AND. .NOT. building_id_f%from_file ) & 3301 THEN 3302 message_string = 'If building_type is provided, also building_id '// & 3303 'is required' 3304 CALL message( 'netcdf_data_input_mod', 'PA0519', 2, 2, 0, 6, 0 ) 3305 ENDIF 3306 ! 3307 !-- If albedo_type is zero at any location, albedo_pars is required. 3308 IF ( albedo_type_f%from_file ) THEN 3309 IF ( ANY( albedo_type_f%var == 0 ) ) THEN 3310 IF ( .NOT. albedo_pars_f%from_file ) THEN 3311 message_string = 'If albedo_type = 0 at any location, ' // & 3312 'albedo_pars is required' 3313 CALL message( 'netcdf_data_input_mod', 'PA0559', 2, 2, myid, 6, 0 ) 3208 ! 3209 !-- Check root distribution. If vegetation_type is 0, all levels must be set. 3210 IF ( vegetation_type_f%from_file ) THEN 3211 IF ( vegetation_type_f%var(j,i) == 0 ) THEN 3212 IF ( ANY( root_area_density_lsm_f%var(:,j,i) == root_area_density_lsm_f%fill ) ) & 3213 THEN 3214 message_string = 'If vegetation_type(y,x) = 0, all ' // & 3215 'levels of root_area_dens_s ' // & 3216 'must be set at this location.' 3217 CALL message( 'netcdf_data_input_mod', 'PA0570', 2, 2, myid, 6, 0 ) 3218 ENDIF 3314 3219 ENDIF 3315 3220 ENDIF 3316 ENDIF 3317 ! 3318 !-- If pavement_type is zero at any location, pavement_pars is required. 3319 IF ( pavement_type_f%from_file ) THEN 3320 IF ( ANY( pavement_type_f%var == 0 ) ) THEN 3321 IF ( .NOT. pavement_pars_f%from_file ) THEN 3322 message_string = 'If pavement_type = 0 at any location, ' // & 3323 'pavement_pars is required' 3324 CALL message( 'netcdf_data_input_mod', 'PA0560', 2, 2, myid, 6, 0 ) 3221 ! 3222 !-- Check soil parameters. If soil_type is 0, all parameters must be set. 3223 IF ( soil_type_f%from_file ) THEN 3224 check_passed = .TRUE. 3225 IF ( ALLOCATED( soil_type_f%var_2d ) ) THEN 3226 IF ( soil_type_f%var_2d(j,i) == 0 ) THEN 3227 IF ( ANY( soil_pars_f%pars_xy(:,j,i) == soil_pars_f%fill ) ) & 3228 check_passed = .FALSE. 3229 ENDIF 3230 ELSE 3231 IF ( ANY( soil_type_f%var_3d(:,j,i) == 0 ) ) THEN 3232 IF ( ANY( soil_pars_f%pars_xy(:,j,i) == soil_pars_f%fill ) ) & 3233 check_passed = .FALSE. 3234 ENDIF 3235 ENDIF 3236 IF ( .NOT. check_passed ) THEN 3237 message_string = 'If soil_type(y,x) = 0, all levels of ' // & 3238 'soil_pars at this location must be set.' 3239 CALL message( 'netcdf_data_input_mod', 'PA0571', 2, 2, myid, 6, 0 ) 3325 3240 ENDIF 3326 3241 ENDIF 3327 ENDIF 3328 ! 3329 !-- If pavement_type is zero at any location, also pavement_subsurface_pars 3330 !-- is required. 3331 IF ( pavement_type_f%from_file ) THEN 3332 IF ( ANY( pavement_type_f%var == 0 ) ) THEN 3333 IF ( .NOT. pavement_subsurface_pars_f%from_file ) THEN 3334 message_string = 'If pavement_type = 0 at any location, ' // & 3335 'pavement_subsurface_pars is required' 3336 CALL message( 'netcdf_data_input_mod', 'PA0561', 2, 2, myid, 6, 0 ) 3242 3243 ! 3244 !-- Check building parameters. If building_type is 0, all parameters must be set. 3245 IF ( building_type_f%from_file ) THEN 3246 IF ( building_type_f%var(j,i) == 0 ) THEN 3247 IF ( ANY( building_pars_f%pars_xy(:,j,i) == building_pars_f%fill ) ) THEN 3248 message_string = 'If building_type(y,x) = 0, all ' // & 3249 'parameters of building_pars at this ' // & 3250 'location must be set.' 3251 CALL message( 'netcdf_data_input_mod', 'PA0572', 2, 2, myid, 6, 0 ) 3252 ENDIF 3337 3253 ENDIF 3338 3254 ENDIF 3339 ENDIF 3340 ! 3341 !-- If water_type is zero at any location, water_pars is required. 3342 IF ( water_type_f%from_file ) THEN 3343 IF ( ANY( water_type_f%var == 0 ) ) THEN 3344 IF ( .NOT. water_pars_f%from_file ) THEN 3345 message_string = 'If water_type = 0 at any location, ' // & 3346 'water_pars is required' 3347 CALL message( 'netcdf_data_input_mod', 'PA0562', 2, 2,myid, 6, 0 ) 3255 ! 3256 !-- Check if building_type is set at each building and vice versa. 3257 !-- Please note, buildings are already processed and filtered. 3258 !-- For this reason, consistency checks are based on wall_flags_total_0 rather than 3259 !-- buildings_f (buildings are represented by bit 6 in wall_flags_total_0). 3260 IF ( building_type_f%from_file .AND. buildings_f%from_file ) THEN 3261 IF ( ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) ) .AND. & 3262 building_type_f%var(j,i) == building_type_f%fill .OR. & 3263 .NOT. ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) ) .AND. & 3264 building_type_f%var(j,i) /= building_type_f%fill ) THEN 3265 WRITE( message_string, * ) 'Each location where a ' // & 3266 'building is set requires a type ' // & 3267 '( and vice versa ) in case the ' // & 3268 'urban-surface model is applied. ' // & 3269 'i, j = ', i, j 3270 CALL message( 'netcdf_data_input_mod', 'PA0573', 2, 2, myid, 6, 0 ) 3348 3271 ENDIF 3349 3272 ENDIF 3350 ENDIF 3351 ! 3352 !-- Check for local consistency of the input data. 3353 DO i = nxl, nxr3354 DO j = nys, nyn3355 ! 3356 !-- For each (y,x)-location at least one of the parameters 3357 !-- vegetation_type, pavement_type, building_type, or water_type 3358 !-- must be set to a nonÂmissing value. 3359 IF ( land_surface .AND. .NOT. urban_surface ) THEN3360 IF ( vegetation_type_f%var(j,i) == vegetation_type_f%fill .AND.&3361 pavement_type_f%var(j,i) == pavement_type_f%fill .AND.&3362 water_type_f%var(j,i) == water_type_f%fill ) THEN3363 WRITE( message_string, * ) & 3364 'At least one of the parameters '// & 3365 'vegetation_type, pavement_type, ' // &3366 'or water_type must be set '//&3367 'to a non-missing value. Grid point: ', j, i3368 CALL message( 'netcdf_data_input_mod', 'PA0563', 2, 2, myid, 6, 0 )3369 ENDIF3370 E LSEIF ( land_surface .AND. urban_surface ) THEN3371 IF ( vegetation_type_f%var(j,i) == vegetation_type_f%fill .AND.&3372 pavement_type_f%var(j,i) == pavement_type_f%fill .AND.& 3373 building_type_f%var(j,i) == building_type_f%fill .AND.& 3374 water_type_f%var(j,i) == water_type_f%fill) THEN3375 WRITE( message_string, * ) &3376 'At least one of the parameters '// &3377 'vegetation_type, pavement_type, ' //&3378 'building_type, or water_type must be set '//&3379 'to a non-missing value. Grid point: ', j, i3380 CALL message( 'netcdf_data_input_mod', 'PA05 63', 2, 2, myid, 6, 0 )3273 ! 3274 !-- Check if at each location where a building is present also an ID is set and vice versa. 3275 IF ( buildings_f%from_file ) THEN 3276 IF ( ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) ) .AND. & 3277 building_id_f%var(j,i) == building_id_f%fill .OR. & 3278 .NOT. ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) ) .AND. & 3279 building_id_f%var(j,i) /= building_id_f%fill ) THEN 3280 WRITE( message_string, * ) 'Each location where a ' // & 3281 'building is set requires an ID ' // & 3282 '( and vice versa ). i, j = ', i, j 3283 CALL message( 'netcdf_data_input_mod', 'PA0574', 2, 2, myid, 6, 0 ) 3284 ENDIF 3285 ENDIF 3286 ! 3287 !-- Check if building ID is set where a bulding is defined. 3288 IF ( buildings_f%from_file ) THEN 3289 IF ( ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) ) .AND. & 3290 building_id_f%var(j,i) == building_id_f%fill ) THEN 3291 WRITE( message_string, * ) 'Each building grid point ' // 'requires an ID.', i, j 3292 CALL message( 'netcdf_data_input_mod', 'PA0575', 2, 2, myid, 6, 0 ) 3293 ENDIF 3294 ENDIF 3295 ! 3296 !-- Check albedo parameters. If albedo_type is 0, all parameters must be set. 3297 IF ( albedo_type_f%from_file ) THEN 3298 IF ( albedo_type_f%var(j,i) == 0 ) THEN 3299 IF ( ANY( albedo_pars_f%pars_xy(:,j,i) == albedo_pars_f%fill ) ) THEN 3300 message_string = 'If albedo_type(y,x) = 0, all ' // & 3301 'parameters of albedo_pars at this ' // & 3302 'location must be set.' 3303 CALL message( 'netcdf_data_input_mod', 'PA0576', 2, 2, myid, 6, 0 ) 3381 3304 ENDIF 3382 3305 ENDIF 3383 3384 ! 3385 !-- Note that a soil_type is required for each location (y,x) where 3386 !-- either vegetation_type or pavement_type is a nonÂmissing value. 3387 IF ( ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill .OR. & 3388 pavement_type_f%var(j,i) /= pavement_type_f%fill ) ) THEN 3389 check_passed = .TRUE. 3390 IF ( ALLOCATED( soil_type_f%var_2d ) ) THEN 3391 IF ( soil_type_f%var_2d(j,i) == soil_type_f%fill ) & 3392 check_passed = .FALSE. 3393 ELSE 3394 IF ( ANY( soil_type_f%var_3d(:,j,i) == soil_type_f%fill) ) & 3395 check_passed = .FALSE. 3396 ENDIF 3397 3398 IF ( .NOT. check_passed ) THEN 3399 message_string = 'soil_type is required for each '// & 3400 'location (y,x) where vegetation_type or ' // & 3401 'pavement_type is a non-missing value.' 3402 CALL message( 'netcdf_data_input_mod', 'PA0564', & 3403 2, 2, myid, 6, 0 ) 3404 ENDIF 3405 ENDIF 3406 ! 3407 !-- Check for consistency of given types. At the moment, only one 3408 !-- of vegetation, pavement, or water-type can be set. This is 3409 !-- because no tile approach is yet implemented in the land-surface 3410 !-- model. Later, when this is possible, surface fraction need to be 3411 !-- given and the sum must not be larger than 1. Please note, in case 3412 !-- more than one type is given at a pixel, an error message will be 3413 !-- given. 3414 n_surf = 0 3415 IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill ) & 3416 n_surf = n_surf + 1 3417 IF ( water_type_f%var(j,i) /= water_type_f%fill ) & 3418 n_surf = n_surf + 1 3419 IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill ) & 3420 n_surf = n_surf + 1 3421 3422 IF ( n_surf > 1 ) THEN 3423 WRITE( message_string, * ) & 3424 'More than one surface type (vegetation, '// & 3425 'pavement, water) is given at a location. '// & 3426 'Please note, this is not possible at ' // & 3427 'the moment as no tile approach has been ' // & 3428 'yet implemented. (i,j) = ', i, j 3429 CALL message( 'netcdf_data_input_mod', 'PA0565', & 3430 2, 2, myid, 6, 0 ) 3431 3432 ! IF ( .NOT. surface_fraction_f%from_file ) THEN 3433 ! message_string = 'More than one surface type (vegetation '//& 3434 ! 'pavement, water) is given at a location. '// & 3435 ! 'Please note, this is not possible at ' // & 3436 ! 'the moment as no tile approach is yet ' // & 3437 ! 'implemented.' 3438 ! message_string = 'If more than one surface type is ' // & 3439 ! 'given at a location, surface_fraction ' // & 3440 ! 'must be provided.' 3441 ! CALL message( 'netcdf_data_input_mod', 'PA0565', & 3442 ! 2, 2, myid, 6, 0 ) 3443 ! ELSEIF ( ANY ( surface_fraction_f%frac(:,j,i) == & 3444 ! surface_fraction_f%fill ) ) THEN 3445 ! message_string = 'If more than one surface type is ' // & 3446 ! 'given at a location, surface_fraction ' // & 3447 ! 'must be provided.' 3448 ! CALL message( 'netcdf_data_input_mod', 'PA0565', & 3449 ! 2, 2, myid, 6, 0 ) 3450 ! ENDIF 3451 ENDIF 3452 ! 3453 !-- Check for further mismatches. e.g. relative fractions exceed 1 or 3454 !-- vegetation_type is set but surface vegetation fraction is zero, 3455 !-- etc.. 3456 IF ( surface_fraction_f%from_file ) THEN 3457 ! 3458 !-- If surface fractions is given, also check that only one type 3459 !-- is given. 3460 IF ( SUM( MERGE( 1, 0, surface_fraction_f%frac(:,j,i) /= 0.0_wp& 3461 .AND. surface_fraction_f%frac(:,j,i) /= & 3462 surface_fraction_f%fill ) ) > 1 ) THEN 3463 WRITE( message_string, * ) & 3464 'surface_fraction is given for more ' // & 3465 'than one type. ' // & 3466 'Please note, this is not possible at ' // & 3467 'the moment as no tile approach has '// & 3468 'yet been implemented. (i, j) = ', i, j 3469 CALL message( 'netcdf_data_input_mod', 'PA0676', & 3470 2, 2, myid, 6, 0 ) 3471 ENDIF 3472 ! 3473 !-- Sum of relative fractions must be 1. Note, attributed to type 3474 !-- conversions due to reading, the sum of surface fractions 3475 !-- might be not exactly 1. Hence, the sum is check with a 3476 !-- tolerance. Later, in the land-surface model, the relative 3477 !-- fractions are normalized to one. Actually, surface fractions 3478 !-- shall be _FillValue at building grid points, however, in order 3479 !-- to relax this requirement and allow that surface-fraction can 3480 !-- also be zero at these grid points, only perform this check 3481 !-- at locations where some vegetation, pavement or water is defined. 3482 IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill .OR.& 3483 pavement_type_f%var(j,i) /= pavement_type_f%fill .OR.& 3484 water_type_f%var(j,i) /= water_type_f%fill ) THEN 3485 IF ( SUM ( surface_fraction_f%frac(0:2,j,i) ) > & 3486 1.0_wp + 1E-8_wp .OR. & 3487 SUM ( surface_fraction_f%frac(0:2,j,i) ) < & 3488 1.0_wp - 1E-8_wp ) THEN 3489 WRITE( message_string, * ) & 3490 'The sum of all land-surface fractions ' //& 3491 'must equal 1. (i, j) = ', i, j 3492 CALL message( 'netcdf_data_input_mod', 'PA0566', & 3493 2, 2, myid, 6, 0 ) 3494 ENDIF 3495 ENDIF 3496 ! 3497 !-- Relative fraction for a type must not be zero at locations where 3498 !-- this type is set. 3499 IF ( & 3500 ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill .AND.& 3501 ( surface_fraction_f%frac(ind_veg_wall,j,i) == 0.0_wp .OR. & 3502 surface_fraction_f%frac(ind_veg_wall,j,i) == & 3503 surface_fraction_f%fill ) & 3504 ) .OR. & 3505 ( pavement_type_f%var(j,i) /= pavement_type_f%fill .AND. & 3506 ( surface_fraction_f%frac(ind_pav_green,j,i) == 0.0_wp .OR. & 3507 surface_fraction_f%frac(ind_pav_green,j,i) == & 3508 surface_fraction_f%fill ) & 3509 ) .OR. & 3510 ( water_type_f%var(j,i) /= water_type_f%fill .AND. & 3511 ( surface_fraction_f%frac(ind_wat_win,j,i) == 0.0_wp .OR. & 3512 surface_fraction_f%frac(ind_wat_win,j,i) == & 3513 surface_fraction_f%fill ) & 3514 ) ) THEN 3515 WRITE( message_string, * ) 'Mismatch in setting of ' // & 3516 'surface_fraction. Vegetation-, pavement-, or '// & 3517 'water surface is given at (i,j) = ( ', i, j, & 3518 ' ), but surface fraction is 0 for the given type.' 3519 CALL message( 'netcdf_data_input_mod', 'PA0567', & 3520 2, 2, myid, 6, 0 ) 3521 ENDIF 3522 ! 3523 !-- Relative fraction for a type must not contain non-zero values 3524 !-- if this type is not set. 3525 IF ( & 3526 ( vegetation_type_f%var(j,i) == vegetation_type_f%fill .AND.& 3527 ( surface_fraction_f%frac(ind_veg_wall,j,i) /= 0.0_wp .AND. & 3528 surface_fraction_f%frac(ind_veg_wall,j,i) /= & 3529 surface_fraction_f%fill ) & 3530 ) .OR. & 3531 ( pavement_type_f%var(j,i) == pavement_type_f%fill .AND. & 3532 ( surface_fraction_f%frac(ind_pav_green,j,i) /= 0.0_wp .AND. & 3533 surface_fraction_f%frac(ind_pav_green,j,i) /= & 3534 surface_fraction_f%fill ) & 3535 ) .OR. & 3536 ( water_type_f%var(j,i) == water_type_f%fill .AND. & 3537 ( surface_fraction_f%frac(ind_wat_win,j,i) /= 0.0_wp .AND. & 3538 surface_fraction_f%frac(ind_wat_win,j,i) /= & 3539 surface_fraction_f%fill ) & 3540 ) ) THEN 3541 WRITE( message_string, * ) 'Mismatch in setting of ' // & 3542 'surface_fraction. Vegetation-, pavement-, or '// & 3543 'water surface is not given at (i,j) = ( ', i, j, & 3544 ' ), but surface fraction is not 0 for the ' // & 3545 'given type.' 3546 CALL message( 'netcdf_data_input_mod', 'PA0568', & 3547 2, 2, myid, 6, 0 ) 3306 ENDIF 3307 3308 ! 3309 !-- Check pavement parameters. If pavement_type is 0, all parameters of pavement_pars must be 3310 !-- set at this location. 3311 IF ( pavement_type_f%from_file ) THEN 3312 IF ( pavement_type_f%var(j,i) == 0 ) THEN 3313 IF ( ANY( pavement_pars_f%pars_xy(:,j,i) == pavement_pars_f%fill ) ) THEN 3314 message_string = 'If pavement_type(y,x) = 0, all ' // & 3315 'parameters of pavement_pars at this '// & 3316 'location must be set.' 3317 CALL message( 'netcdf_data_input_mod', 'PA0577', 2, 2, myid, 6, 0 ) 3548 3318 ENDIF 3549 3319 ENDIF 3550 ! 3551 !-- Check vegetation_pars. If vegetation_type is 0, all parameters 3552 !-- need to be set, otherwise, single parameters set by 3553 !-- vegetation_type can be overwritten. 3554 IF ( vegetation_type_f%from_file ) THEN 3555 IF ( vegetation_type_f%var(j,i) == 0 ) THEN 3556 IF ( ANY( vegetation_pars_f%pars_xy(:,j,i) == & 3557 vegetation_pars_f%fill ) ) THEN 3558 message_string = 'If vegetation_type(y,x) = 0, all ' // & 3559 'parameters of vegetation_pars at '// & 3560 'this location must be set.' 3561 CALL message( 'netcdf_data_input_mod', 'PA0569', & 3562 2, 2, myid, 6, 0 ) 3563 ENDIF 3320 ENDIF 3321 ! 3322 !-- Check pavement-subsurface parameters. If pavement_type is 0, all parameters of 3323 !-- pavement_subsurface_pars must be set at this location. 3324 IF ( pavement_type_f%from_file ) THEN 3325 IF ( pavement_type_f%var(j,i) == 0 ) THEN 3326 IF ( ANY( pavement_subsurface_pars_f%pars_xyz(:,:,j,i) == & 3327 pavement_subsurface_pars_f%fill ) ) THEN 3328 message_string = 'If pavement_type(y,x) = 0, all ' // & 3329 'parameters of ' // & 3330 'pavement_subsurface_pars at this ' // & 3331 'location must be set.' 3332 CALL message( 'netcdf_data_input_mod', 'PA0578', 2, 2, myid, 6, 0 ) 3564 3333 ENDIF 3565 3334 ENDIF 3566 ! 3567 !-- Check root distribution. If vegetation_type is 0, all levels must 3568 !-- be set. 3569 IF ( vegetation_type_f%from_file ) THEN 3570 IF ( vegetation_type_f%var(j,i) == 0 ) THEN 3571 IF ( ANY( root_area_density_lsm_f%var(:,j,i) == & 3572 root_area_density_lsm_f%fill ) ) THEN 3573 message_string = 'If vegetation_type(y,x) = 0, all ' // & 3574 'levels of root_area_dens_s ' // & 3575 'must be set at this location.' 3576 CALL message( 'netcdf_data_input_mod', 'PA0570', & 3577 2, 2, myid, 6, 0 ) 3578 ENDIF 3335 ENDIF 3336 3337 ! 3338 !-- Check water parameters. If water_type is 0, all parameters must be set at this location. 3339 IF ( water_type_f%from_file ) THEN 3340 IF ( water_type_f%var(j,i) == 0 ) THEN 3341 IF ( ANY( water_pars_f%pars_xy(:,j,i) == water_pars_f%fill ) ) THEN 3342 message_string = 'If water_type(y,x) = 0, all ' // & 3343 'parameters of water_pars at this ' // & 3344 'location must be set.' 3345 CALL message( 'netcdf_data_input_mod', 'PA0579', 2, 2, myid, 6, 0 ) 3579 3346 ENDIF 3580 3347 ENDIF 3581 ! 3582 !-- Check soil parameters. If soil_type is 0, all parameters 3583 !-- must be set. 3584 IF ( soil_type_f%from_file ) THEN 3585 check_passed = .TRUE. 3586 IF ( ALLOCATED( soil_type_f%var_2d ) ) THEN 3587 IF ( soil_type_f%var_2d(j,i) == 0 ) THEN 3588 IF ( ANY( soil_pars_f%pars_xy(:,j,i) == & 3589 soil_pars_f%fill ) ) check_passed = .FALSE. 3590 ENDIF 3591 ELSE 3592 IF ( ANY( soil_type_f%var_3d(:,j,i) == 0 ) ) THEN 3593 IF ( ANY( soil_pars_f%pars_xy(:,j,i) == & 3594 soil_pars_f%fill ) ) check_passed = .FALSE. 3595 ENDIF 3596 ENDIF 3597 IF ( .NOT. check_passed ) THEN 3598 message_string = 'If soil_type(y,x) = 0, all levels of ' //& 3599 'soil_pars at this location must be set.' 3600 CALL message( 'netcdf_data_input_mod', 'PA0571', & 3601 2, 2, myid, 6, 0 ) 3602 ENDIF 3603 ENDIF 3604 3605 ! 3606 !-- Check building parameters. If building_type is 0, all parameters 3607 !-- must be set. 3608 IF ( building_type_f%from_file ) THEN 3609 IF ( building_type_f%var(j,i) == 0 ) THEN 3610 IF ( ANY( building_pars_f%pars_xy(:,j,i) == & 3611 building_pars_f%fill ) ) THEN 3612 message_string = 'If building_type(y,x) = 0, all ' // & 3613 'parameters of building_pars at this '//& 3614 'location must be set.' 3615 CALL message( 'netcdf_data_input_mod', 'PA0572', & 3616 2, 2, myid, 6, 0 ) 3617 ENDIF 3618 ENDIF 3619 ENDIF 3620 ! 3621 !-- Check if building_type is set at each building and vice versa. 3622 !-- Please note, buildings are already processed and filtered. 3623 !-- For this reason, consistency checks are based on wall_flags_total_0 3624 !-- rather than buildings_f (buildings are represented by bit 6 in 3625 !-- wall_flags_total_0). 3626 IF ( building_type_f%from_file .AND. buildings_f%from_file ) THEN 3627 IF ( ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) ) .AND. & 3628 building_type_f%var(j,i) == building_type_f%fill .OR. & 3629 .NOT. ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) ) .AND. & 3630 building_type_f%var(j,i) /= building_type_f%fill ) THEN 3631 WRITE( message_string, * ) 'Each location where a ' // & 3632 'building is set requires a type ' // & 3633 '( and vice versa ) in case the ' // & 3634 'urban-surface model is applied. ' // & 3635 'i, j = ', i, j 3636 CALL message( 'netcdf_data_input_mod', 'PA0573', & 3637 2, 2, myid, 6, 0 ) 3638 ENDIF 3639 ENDIF 3640 ! 3641 !-- Check if at each location where a building is present also an ID 3642 !-- is set and vice versa. 3643 IF ( buildings_f%from_file ) THEN 3644 IF ( ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) ) .AND. & 3645 building_id_f%var(j,i) == building_id_f%fill .OR. & 3646 .NOT. ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) ) .AND. & 3647 building_id_f%var(j,i) /= building_id_f%fill ) THEN 3648 WRITE( message_string, * ) 'Each location where a ' // & 3649 'building is set requires an ID ' // & 3650 '( and vice versa ). i, j = ', i, j 3651 CALL message( 'netcdf_data_input_mod', 'PA0574', & 3652 2, 2, myid, 6, 0 ) 3653 ENDIF 3654 ENDIF 3655 ! 3656 !-- Check if building ID is set where a bulding is defined. 3657 IF ( buildings_f%from_file ) THEN 3658 IF ( ANY( BTEST ( wall_flags_total_0(:,j,i), 6 ) ) .AND. & 3659 building_id_f%var(j,i) == building_id_f%fill ) THEN 3660 WRITE( message_string, * ) 'Each building grid point '// & 3661 'requires an ID.', i, j 3662 CALL message( 'netcdf_data_input_mod', 'PA0575', & 3663 2, 2, myid, 6, 0 ) 3664 ENDIF 3665 ENDIF 3666 ! 3667 !-- Check albedo parameters. If albedo_type is 0, all parameters 3668 !-- must be set. 3669 IF ( albedo_type_f%from_file ) THEN 3670 IF ( albedo_type_f%var(j,i) == 0 ) THEN 3671 IF ( ANY( albedo_pars_f%pars_xy(:,j,i) == & 3672 albedo_pars_f%fill ) ) THEN 3673 message_string = 'If albedo_type(y,x) = 0, all ' // & 3674 'parameters of albedo_pars at this ' // & 3675 'location must be set.' 3676 CALL message( 'netcdf_data_input_mod', 'PA0576', & 3677 2, 2, myid, 6, 0 ) 3678 ENDIF 3679 ENDIF 3680 ENDIF 3681 3682 ! 3683 !-- Check pavement parameters. If pavement_type is 0, all parameters 3684 !-- of pavement_pars must be set at this location. 3685 IF ( pavement_type_f%from_file ) THEN 3686 IF ( pavement_type_f%var(j,i) == 0 ) THEN 3687 IF ( ANY( pavement_pars_f%pars_xy(:,j,i) == & 3688 pavement_pars_f%fill ) ) THEN 3689 message_string = 'If pavement_type(y,x) = 0, all ' // & 3690 'parameters of pavement_pars at this '//& 3691 'location must be set.' 3692 CALL message( 'netcdf_data_input_mod', 'PA0577', & 3693 2, 2, myid, 6, 0 ) 3694 ENDIF 3695 ENDIF 3696 ENDIF 3697 ! 3698 !-- Check pavement-subsurface parameters. If pavement_type is 0, 3699 !-- all parameters of pavement_subsurface_pars must be set at this 3700 !-- location. 3701 IF ( pavement_type_f%from_file ) THEN 3702 IF ( pavement_type_f%var(j,i) == 0 ) THEN 3703 IF ( ANY( pavement_subsurface_pars_f%pars_xyz(:,:,j,i) == & 3704 pavement_subsurface_pars_f%fill ) ) THEN 3705 message_string = 'If pavement_type(y,x) = 0, all ' // & 3706 'parameters of ' // & 3707 'pavement_subsurface_pars at this '// & 3708 'location must be set.' 3709 CALL message( 'netcdf_data_input_mod', 'PA0578', & 3710 2, 2, myid, 6, 0 ) 3711 ENDIF 3712 ENDIF 3713 ENDIF 3714 3715 ! 3716 !-- Check water parameters. If water_type is 0, all parameters 3717 !-- must be set at this location. 3718 IF ( water_type_f%from_file ) THEN 3719 IF ( water_type_f%var(j,i) == 0 ) THEN 3720 IF ( ANY( water_pars_f%pars_xy(:,j,i) == & 3721 water_pars_f%fill ) ) THEN 3722 message_string = 'If water_type(y,x) = 0, all ' // & 3723 'parameters of water_pars at this ' // & 3724 'location must be set.' 3725 CALL message( 'netcdf_data_input_mod', 'PA0579', & 3726 2, 2, myid, 6, 0 ) 3727 ENDIF 3728 ENDIF 3729 ENDIF 3730 3731 ENDDO 3348 ENDIF 3349 3732 3350 ENDDO 3733 3734 END SUBROUTINE netcdf_data_input_check_static 3735 3736 !------------------------------------------------------------------------------! 3351 ENDDO 3352 3353 END SUBROUTINE netcdf_data_input_check_static 3354 3355 3356 !--------------------------------------------------------------------------------------------------! 3737 3357 ! Description: 3738 3358 ! ------------ 3739 3359 !> Resize 8-bit 2D Integer array: (nys:nyn,nxl:nxr) -> (nysg:nyng,nxlg:nxrg) 3740 !------------------------------------------------------------------------------! 3741 SUBROUTINE resize_array_2d_int8( var, js, je, is, ie ) 3742 3743 IMPLICIT NONE 3744 3745 INTEGER(iwp) :: je !< upper index bound along y direction 3746 INTEGER(iwp) :: js !< lower index bound along y direction 3747 INTEGER(iwp) :: ie !< upper index bound along x direction 3748 INTEGER(iwp) :: is !< lower index bound along x direction 3749 3750 INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE :: var !< treated variable 3751 INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE :: var_tmp !< temporary copy 3752 ! 3753 !-- Allocate temporary variable 3754 ALLOCATE( var_tmp(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3755 ! 3756 !-- Temporary copy of the variable 3757 var_tmp(js:je,is:ie) = var(js:je,is:ie) 3758 ! 3759 !-- Resize the array 3760 DEALLOCATE( var ) 3761 ALLOCATE( var(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3762 ! 3763 !-- Transfer temporary copy back to original array 3764 var(js:je,is:ie) = var_tmp(js:je,is:ie) 3765 3766 END SUBROUTINE resize_array_2d_int8 3767 3768 !------------------------------------------------------------------------------! 3360 !--------------------------------------------------------------------------------------------------! 3361 SUBROUTINE resize_array_2d_int8( var, js, je, is, ie ) 3362 3363 IMPLICIT NONE 3364 3365 INTEGER(iwp) :: ie !< upper index bound along x direction 3366 INTEGER(iwp) :: is !< lower index bound along x direction 3367 INTEGER(iwp) :: je !< upper index bound along y direction 3368 INTEGER(iwp) :: js !< lower index bound along y direction 3369 3370 INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE :: var !< treated variable 3371 INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE :: var_tmp !< temporary copy 3372 ! 3373 !-- Allocate temporary variable 3374 ALLOCATE( var_tmp(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3375 ! 3376 !-- Temporary copy of the variable 3377 var_tmp(js:je,is:ie) = var(js:je,is:ie) 3378 ! 3379 !-- Resize the array 3380 DEALLOCATE( var ) 3381 ALLOCATE( var(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3382 ! 3383 !-- Transfer temporary copy back to original array 3384 var(js:je,is:ie) = var_tmp(js:je,is:ie) 3385 3386 END SUBROUTINE resize_array_2d_int8 3387 3388 3389 !--------------------------------------------------------------------------------------------------! 3769 3390 ! Description: 3770 3391 ! ------------ 3771 3392 !> Resize 32-bit 2D Integer array: (nys:nyn,nxl:nxr) -> (nysg:nyng,nxlg:nxrg) 3772 !------------------------------------------------------------------------------! 3773 SUBROUTINE resize_array_2d_int32( var, js, je, is, ie ) 3774 3775 IMPLICIT NONE 3776 3777 INTEGER(iwp) :: je !< upper index bound along y direction 3778 INTEGER(iwp) :: js !< lower index bound along y direction 3779 INTEGER(iwp) :: ie !< upper index bound along x direction 3780 INTEGER(iwp) :: is !< lower index bound along x direction 3781 3782 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: var !< treated variable 3783 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: var_tmp !< temporary copy 3784 ! 3785 !-- Allocate temporary variable 3786 ALLOCATE( var_tmp(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3787 ! 3788 !-- Temporary copy of the variable 3789 var_tmp(js:je,is:ie) = var(js:je,is:ie) 3790 ! 3791 !-- Resize the array 3792 DEALLOCATE( var ) 3793 ALLOCATE( var(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3794 ! 3795 !-- Transfer temporary copy back to original array 3796 var(js:je,is:ie) = var_tmp(js:je,is:ie) 3797 3798 END SUBROUTINE resize_array_2d_int32 3799 3800 !------------------------------------------------------------------------------! 3393 !--------------------------------------------------------------------------------------------------! 3394 SUBROUTINE resize_array_2d_int32( var, js, je, is, ie ) 3395 3396 IMPLICIT NONE 3397 3398 INTEGER(iwp) :: ie !< upper index bound along x direction 3399 INTEGER(iwp) :: is !< lower index bound along x direction 3400 INTEGER(iwp) :: je !< upper index bound along y direction 3401 INTEGER(iwp) :: js !< lower index bound along y direction 3402 3403 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: var !< treated variable 3404 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: var_tmp !< temporary copy 3405 ! 3406 !-- Allocate temporary variable 3407 ALLOCATE( var_tmp(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3408 ! 3409 !-- Temporary copy of the variable 3410 var_tmp(js:je,is:ie) = var(js:je,is:ie) 3411 ! 3412 !-- Resize the array 3413 DEALLOCATE( var ) 3414 ALLOCATE( var(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3415 ! 3416 !-- Transfer temporary copy back to original array 3417 var(js:je,is:ie) = var_tmp(js:je,is:ie) 3418 3419 END SUBROUTINE resize_array_2d_int32 3420 3421 3422 !--------------------------------------------------------------------------------------------------! 3801 3423 ! Description: 3802 3424 ! ------------ 3803 3425 !> Resize 8-bit 3D Integer array: (:,nys:nyn,nxl:nxr) -> (:,nysg:nyng,nxlg:nxrg) 3804 !------------------------------------------------------------------------------! 3805 SUBROUTINE resize_array_3d_int8( var, ks, ke, js, je, is, ie ) 3806 3807 IMPLICIT NONE 3808 3809 INTEGER(iwp) :: je !< upper index bound along y direction 3810 INTEGER(iwp) :: js !< lower index bound along y direction 3811 INTEGER(iwp) :: ie !< upper index bound along x direction 3812 INTEGER(iwp) :: is !< lower index bound along x direction 3813 INTEGER(iwp) :: ke !< upper bound of treated array in z-direction 3814 INTEGER(iwp) :: ks !< lower bound of treated array in z-direction 3815 3816 INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: var !< treated variable 3817 INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: var_tmp !< temporary copy 3818 ! 3819 !-- Allocate temporary variable 3820 ALLOCATE( var_tmp(ks:ke,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3821 ! 3822 !-- Temporary copy of the variable 3823 var_tmp(ks:ke,js:je,is:ie) = var(ks:ke,js:je,is:ie) 3824 ! 3825 !-- Resize the array 3826 DEALLOCATE( var ) 3827 ALLOCATE( var(ks:ke,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3828 ! 3829 !-- Transfer temporary copy back to original array 3830 var(ks:ke,js:je,is:ie) = var_tmp(ks:ke,js:je,is:ie) 3831 3832 END SUBROUTINE resize_array_3d_int8 3833 3834 !------------------------------------------------------------------------------! 3426 !--------------------------------------------------------------------------------------------------! 3427 SUBROUTINE resize_array_3d_int8( var, ks, ke, js, je, is, ie ) 3428 3429 IMPLICIT NONE 3430 3431 INTEGER(iwp) :: ie !< upper index bound along x direction 3432 INTEGER(iwp) :: is !< lower index bound along x direction 3433 INTEGER(iwp) :: je !< upper index bound along y direction 3434 INTEGER(iwp) :: js !< lower index bound along y direction 3435 INTEGER(iwp) :: ke !< upper bound of treated array in z-direction 3436 INTEGER(iwp) :: ks !< lower bound of treated array in z-direction 3437 3438 INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: var !< treated variable 3439 INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: var_tmp !< temporary copy 3440 ! 3441 !-- Allocate temporary variable 3442 ALLOCATE( var_tmp(ks:ke,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3443 ! 3444 !-- Temporary copy of the variable 3445 var_tmp(ks:ke,js:je,is:ie) = var(ks:ke,js:je,is:ie) 3446 ! 3447 !-- Resize the array 3448 DEALLOCATE( var ) 3449 ALLOCATE( var(ks:ke,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3450 ! 3451 !-- Transfer temporary copy back to original array 3452 var(ks:ke,js:je,is:ie) = var_tmp(ks:ke,js:je,is:ie) 3453 3454 END SUBROUTINE resize_array_3d_int8 3455 3456 3457 !--------------------------------------------------------------------------------------------------! 3835 3458 ! Description: 3836 3459 ! ------------ 3837 3460 !> Resize 3D Real array: (:,nys:nyn,nxl:nxr) -> (:,nysg:nyng,nxlg:nxrg) 3838 !------------------------------------------------------------------------------! 3839 SUBROUTINE resize_array_3d_real( var, ks, ke, js, je, is, ie ) 3840 3841 IMPLICIT NONE 3842 3843 INTEGER(iwp) :: je !< upper index bound along y direction 3844 INTEGER(iwp) :: js !< lower index bound along y direction 3845 INTEGER(iwp) :: ie !< upper index bound along x direction 3846 INTEGER(iwp) :: is !< lower index bound along x direction 3847 INTEGER(iwp) :: ke !< upper bound of treated array in z-direction 3848 INTEGER(iwp) :: ks !< lower bound of treated array in z-direction 3849 3850 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: var !< treated variable 3851 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: var_tmp !< temporary copy 3852 ! 3853 !-- Allocate temporary variable 3854 ALLOCATE( var_tmp(ks:ke,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3855 ! 3856 !-- Temporary copy of the variable 3857 var_tmp(ks:ke,js:je,is:ie) = var(ks:ke,js:je,is:ie) 3858 ! 3859 !-- Resize the array 3860 DEALLOCATE( var ) 3861 ALLOCATE( var(ks:ke,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3862 ! 3863 !-- Transfer temporary copy back to original array 3864 var(ks:ke,js:je,is:ie) = var_tmp(ks:ke,js:je,is:ie) 3865 3866 END SUBROUTINE resize_array_3d_real 3867 3868 !------------------------------------------------------------------------------! 3461 !--------------------------------------------------------------------------------------------------! 3462 SUBROUTINE resize_array_3d_real( var, ks, ke, js, je, is, ie ) 3463 3464 IMPLICIT NONE 3465 3466 INTEGER(iwp) :: ie !< upper index bound along x direction 3467 INTEGER(iwp) :: is !< lower index bound along x direction 3468 INTEGER(iwp) :: je !< upper index bound along y direction 3469 INTEGER(iwp) :: js !< lower index bound along y direction 3470 INTEGER(iwp) :: ke !< upper bound of treated array in z-direction 3471 INTEGER(iwp) :: ks !< lower bound of treated array in z-direction 3472 3473 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: var !< treated variable 3474 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: var_tmp !< temporary copy 3475 ! 3476 !-- Allocate temporary variable 3477 ALLOCATE( var_tmp(ks:ke,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3478 ! 3479 !-- Temporary copy of the variable 3480 var_tmp(ks:ke,js:je,is:ie) = var(ks:ke,js:je,is:ie) 3481 ! 3482 !-- Resize the array 3483 DEALLOCATE( var ) 3484 ALLOCATE( var(ks:ke,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3485 ! 3486 !-- Transfer temporary copy back to original array 3487 var(ks:ke,js:je,is:ie) = var_tmp(ks:ke,js:je,is:ie) 3488 3489 END SUBROUTINE resize_array_3d_real 3490 3491 3492 !--------------------------------------------------------------------------------------------------! 3869 3493 ! Description: 3870 3494 ! ------------ 3871 3495 !> Resize 4D Real array: (:,:,nys:nyn,nxl:nxr) -> (:,nysg:nyng,nxlg:nxrg) 3872 !------------------------------------------------------------------------------! 3873 SUBROUTINE resize_array_4d_real( var, k1s, k1e, k2s, k2e, js, je, is, ie ) 3874 3875 IMPLICIT NONE 3876 3877 INTEGER(iwp) :: je !< upper index bound along y direction 3878 INTEGER(iwp) :: js !< lower index bound along y direction 3879 INTEGER(iwp) :: ie !< upper index bound along x direction 3880 INTEGER(iwp) :: is !< lower index bound along x direction 3881 INTEGER(iwp) :: k1e !< upper bound of treated array in z-direction 3882 INTEGER(iwp) :: k1s !< lower bound of treated array in z-direction 3883 INTEGER(iwp) :: k2e !< upper bound of treated array along parameter space 3884 INTEGER(iwp) :: k2s !< lower bound of treated array along parameter space 3885 3886 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: var !< treated variable 3887 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: var_tmp !< temporary copy 3888 ! 3889 !-- Allocate temporary variable 3890 ALLOCATE( var_tmp(k1s:k1e,k2s:k2e,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3891 ! 3892 !-- Temporary copy of the variable 3893 var_tmp(k1s:k1e,k2s:k2e,js:je,is:ie) = var(k1s:k1e,k2s:k2e,js:je,is:ie) 3894 ! 3895 !-- Resize the array 3896 DEALLOCATE( var ) 3897 ALLOCATE( var(k1s:k1e,k2s:k2e,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3898 ! 3899 !-- Transfer temporary copy back to original array 3900 var(k1s:k1e,k2s:k2e,js:je,is:ie) = var_tmp(k1s:k1e,k2s:k2e,js:je,is:ie) 3901 3902 END SUBROUTINE resize_array_4d_real 3903 3904 !------------------------------------------------------------------------------! 3496 !--------------------------------------------------------------------------------------------------! 3497 SUBROUTINE resize_array_4d_real( var, k1s, k1e, k2s, k2e, js, je, is, ie ) 3498 3499 IMPLICIT NONE 3500 3501 INTEGER(iwp) :: ie !< upper index bound along x direction 3502 INTEGER(iwp) :: is !< lower index bound along x direction 3503 INTEGER(iwp) :: je !< upper index bound along y direction 3504 INTEGER(iwp) :: js !< lower index bound along y direction 3505 INTEGER(iwp) :: k1e !< upper bound of treated array in z-direction 3506 INTEGER(iwp) :: k1s !< lower bound of treated array in z-direction 3507 INTEGER(iwp) :: k2e !< upper bound of treated array along parameter space 3508 INTEGER(iwp) :: k2s !< lower bound of treated array along parameter space 3509 3510 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: var !< treated variable 3511 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: var_tmp !< temporary copy 3512 ! 3513 !-- Allocate temporary variable 3514 ALLOCATE( var_tmp(k1s:k1e,k2s:k2e,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3515 ! 3516 !-- Temporary copy of the variable 3517 var_tmp(k1s:k1e,k2s:k2e,js:je,is:ie) = var(k1s:k1e,k2s:k2e,js:je,is:ie) 3518 ! 3519 !-- Resize the array 3520 DEALLOCATE( var ) 3521 ALLOCATE( var(k1s:k1e,k2s:k2e,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 3522 ! 3523 !-- Transfer temporary copy back to original array 3524 var(k1s:k1e,k2s:k2e,js:je,is:ie) = var_tmp(k1s:k1e,k2s:k2e,js:je,is:ie) 3525 3526 END SUBROUTINE resize_array_4d_real 3527 3528 3529 !--------------------------------------------------------------------------------------------------! 3905 3530 ! Description: 3906 3531 ! ------------ 3907 3532 !> Checks if a given variables is on file 3908 !------------------------------------------------------------------------------! 3909 FUNCTION check_existence( vars_in_file, var_name ) 3910 3911 IMPLICIT NONE 3912 3913 CHARACTER(LEN=*) :: var_name !< variable to be checked 3914 CHARACTER(LEN=*), DIMENSION(:) :: vars_in_file !< list of variables in file 3915 3916 INTEGER(iwp) :: i !< loop variable 3917 3918 LOGICAL :: check_existence !< flag indicating whether a variable exist or not - actual return value 3919 3920 i = 1 3921 check_existence = .FALSE. 3922 DO WHILE ( i <= SIZE( vars_in_file ) ) 3923 check_existence = TRIM( vars_in_file(i) ) == TRIM( var_name ) .OR. & 3924 check_existence 3925 i = i + 1 3926 ENDDO 3927 3928 RETURN 3929 3930 END FUNCTION check_existence 3931 3932 3933 !------------------------------------------------------------------------------! 3533 !--------------------------------------------------------------------------------------------------! 3534 FUNCTION check_existence( vars_in_file, var_name ) 3535 3536 IMPLICIT NONE 3537 3538 CHARACTER(LEN=*) :: var_name !< variable to be checked 3539 CHARACTER(LEN=*), DIMENSION(:) :: vars_in_file !< list of variables in file 3540 3541 INTEGER(iwp) :: i !< loop variable 3542 3543 LOGICAL :: check_existence !< flag indicating whether a variable exist or not - actual return value 3544 3545 i = 1 3546 check_existence = .FALSE. 3547 DO WHILE ( i <= SIZE( vars_in_file ) ) 3548 check_existence = TRIM( vars_in_file(i) ) == TRIM( var_name ) .OR. check_existence 3549 i = i + 1 3550 ENDDO 3551 3552 RETURN 3553 3554 END FUNCTION check_existence 3555 3556 3557 !--------------------------------------------------------------------------------------------------! 3934 3558 ! Description: 3935 3559 ! ------------ 3936 3560 !> Closes an existing netCDF file. 3937 !------------------------------------------------------------------------------ !3938 3939 3940 3941 3942 3943 3944 INTEGER(iwp), INTENT(INOUT) :: id!< file id3561 !--------------------------------------------------------------------------------------------------! 3562 SUBROUTINE close_input_file( id ) 3563 3564 USE pegrid 3565 3566 IMPLICIT NONE 3567 3568 INTEGER(iwp), INTENT(INOUT) :: id !< file id 3945 3569 3946 3570 #if defined( __netcdf ) 3947 3948 3571 nc_stat = NF90_CLOSE( id ) 3572 CALL handle_error( 'close', 540 ) 3949 3573 #endif 3950 END SUBROUTINE close_input_file 3951 3952 !------------------------------------------------------------------------------! 3574 3575 END SUBROUTINE close_input_file 3576 3577 3578 !--------------------------------------------------------------------------------------------------! 3953 3579 ! Description: 3954 3580 ! ------------ 3955 3581 !> Opens an existing netCDF file for reading only and returns its id. 3956 !------------------------------------------------------------------------------ !3957 3958 3959 3960 3961 3962 3963 3964 3582 !--------------------------------------------------------------------------------------------------! 3583 SUBROUTINE open_read_file( filename, id ) 3584 3585 USE pegrid 3586 3587 IMPLICIT NONE 3588 3589 CHARACTER (LEN=*), INTENT(IN) :: filename !< filename 3590 INTEGER(iwp), INTENT(INOUT) :: id !< file id 3965 3591 3966 3592 #if defined( __netcdf ) … … 3968 3594 #if defined( __netcdf4_parallel ) 3969 3595 ! 3970 !-- 3971 nc_stat = NF90_OPEN( filename, IOR( NF90_NOWRITE, NF90_MPIIO ), id,&3972 COMM = comm2d,INFO = MPI_INFO_NULL )3973 ! 3974 !-- In case the previous open call fails, check for possible Netcdf 3 file,3975 !-- and open it. However, this case, disable parallel access.3976 3977 3978 3979 3596 !-- If __netcdf4_parallel is defined, parrallel NetCDF will be used. 3597 nc_stat = NF90_OPEN( filename, IOR( NF90_NOWRITE, NF90_MPIIO ), id, COMM = comm2d, & 3598 INFO = MPI_INFO_NULL ) 3599 ! 3600 !-- In case the previous open call fails, check for possible Netcdf 3 file, and open it. However, 3601 !-- this case, disable parallel access. 3602 IF( nc_stat /= NF90_NOERR ) THEN 3603 nc_stat = NF90_OPEN( filename, NF90_NOWRITE, id ) 3604 collective_read = .FALSE. 3605 ELSE 3980 3606 #if defined( __nec ) 3981 3607 collective_read = .FALSE. ! collective read causes hang situations on NEC Aurora 3982 3608 #else 3983 3609 collective_read = .TRUE. 3984 3610 #endif 3985 3611 ENDIF 3986 3612 #else 3987 3613 ! 3988 !-- 3989 3614 !-- All MPI processes open the file and read it (but not in parallel). 3615 nc_stat = NF90_OPEN( filename, NF90_NOWRITE, id ) 3990 3616 #endif 3991 3617 3992 3618 CALL handle_error( 'open_read_file', 539 ) 3993 3619 3994 3620 #endif 3995 END SUBROUTINE open_read_file 3996 3997 !------------------------------------------------------------------------------! 3621 END SUBROUTINE open_read_file 3622 3623 3624 !--------------------------------------------------------------------------------------------------! 3998 3625 ! Description: 3999 3626 ! ------------ 4000 3627 !> Reads global or variable-related attributes of type INTEGER (32-bit) 4001 !------------------------------------------------------------------------------! 4002 SUBROUTINE get_attribute_int32( id, attribute_name, value, global, & 4003 variable_name, no_abort ) 4004 4005 USE pegrid 4006 4007 IMPLICIT NONE 4008 4009 CHARACTER(LEN=*) :: attribute_name !< attribute name 4010 CHARACTER(LEN=*), OPTIONAL :: variable_name !< variable name 4011 4012 INTEGER(iwp), INTENT(IN) :: id !< file id 4013 INTEGER(iwp) :: id_var !< variable id 4014 INTEGER(iwp), INTENT(INOUT) :: value !< read value 4015 4016 LOGICAL :: check_error !< flag indicating if handle_error shall be checked 4017 LOGICAL, INTENT(IN) :: global !< flag indicating global attribute 4018 LOGICAL, INTENT(IN), OPTIONAL :: no_abort !< flag indicating if errors should be checked 3628 !--------------------------------------------------------------------------------------------------! 3629 SUBROUTINE get_attribute_int32( id, attribute_name, value, global, variable_name, no_abort ) 3630 3631 USE pegrid 3632 3633 IMPLICIT NONE 3634 3635 CHARACTER(LEN=*) :: attribute_name !< attribute name 3636 CHARACTER(LEN=*), OPTIONAL :: variable_name !< variable name 3637 3638 INTEGER(iwp), INTENT(IN) :: id !< file id 3639 INTEGER(iwp) :: id_var !< variable id 3640 INTEGER(iwp), INTENT(INOUT) :: value !< read value 3641 3642 LOGICAL :: check_error !< flag indicating if handle_error shall be checked 3643 LOGICAL, INTENT(IN) :: global !< flag indicating global attribute 3644 LOGICAL, INTENT(IN), OPTIONAL :: no_abort !< flag indicating if errors should be checked 4019 3645 #if defined( __netcdf ) 4020 3646 4021 IF ( PRESENT( no_abort ) ) THEN 4022 check_error = no_abort 4023 ELSE 4024 check_error = .TRUE. 4025 ENDIF 4026 ! 4027 !-- Read global attribute 4028 IF ( global ) THEN 4029 nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value ) 4030 IF ( check_error) CALL handle_error( 'get_attribute_int32 global', 522, attribute_name ) 4031 ! 4032 !-- Read attributes referring to a single variable. Therefore, first inquire 4033 !-- variable id 4034 ELSE 4035 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4036 IF ( check_error) CALL handle_error( 'get_attribute_int32', 522, attribute_name ) 4037 nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value ) 4038 IF ( check_error) CALL handle_error( 'get_attribute_int32', 522, attribute_name ) 4039 ENDIF 3647 IF ( PRESENT( no_abort ) ) THEN 3648 check_error = no_abort 3649 ELSE 3650 check_error = .TRUE. 3651 ENDIF 3652 ! 3653 !-- Read global attribute 3654 IF ( global ) THEN 3655 nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value ) 3656 IF ( check_error) CALL handle_error( 'get_attribute_int32 global', 522, attribute_name ) 3657 ! 3658 !-- Read attributes referring to a single variable. Therefore, first inquire variable id 3659 ELSE 3660 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 3661 IF ( check_error) CALL handle_error( 'get_attribute_int32', 522, attribute_name ) 3662 nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value ) 3663 IF ( check_error) CALL handle_error( 'get_attribute_int32', 522, attribute_name ) 3664 ENDIF 4040 3665 #endif 4041 END SUBROUTINE get_attribute_int32 4042 4043 !------------------------------------------------------------------------------! 3666 3667 END SUBROUTINE get_attribute_int32 3668 3669 3670 !--------------------------------------------------------------------------------------------------! 4044 3671 ! Description: 4045 3672 ! ------------ 4046 3673 !> Reads global or variable-related attributes of type INTEGER (8-bit) 4047 !------------------------------------------------------------------------------! 4048 SUBROUTINE get_attribute_int8( id, attribute_name, value, global, & 4049 variable_name, no_abort ) 4050 4051 USE pegrid 4052 4053 IMPLICIT NONE 4054 4055 CHARACTER(LEN=*) :: attribute_name !< attribute name 4056 CHARACTER(LEN=*), OPTIONAL :: variable_name !< variable name 4057 4058 INTEGER(iwp), INTENT(IN) :: id !< file id 4059 INTEGER(iwp) :: id_var !< variable id 4060 INTEGER(KIND=1), INTENT(INOUT) :: value !< read value 4061 4062 LOGICAL :: check_error !< flag indicating if handle_error shall be checked 4063 LOGICAL, INTENT(IN), OPTIONAL :: no_abort !< flag indicating if errors should be checked 4064 LOGICAL, INTENT(IN) :: global !< flag indicating global attribute 3674 !--------------------------------------------------------------------------------------------------! 3675 SUBROUTINE get_attribute_int8( id, attribute_name, value, global, variable_name, no_abort ) 3676 3677 USE pegrid 3678 3679 IMPLICIT NONE 3680 3681 CHARACTER(LEN=*) :: attribute_name !< attribute name 3682 CHARACTER(LEN=*), OPTIONAL :: variable_name !< variable name 3683 3684 INTEGER(iwp), INTENT(IN) :: id !< file id 3685 INTEGER(iwp) :: id_var !< variable id 3686 INTEGER(KIND=1), INTENT(INOUT) :: value !< read value 3687 3688 LOGICAL :: check_error !< flag indicating if handle_error shall be checked 3689 LOGICAL, INTENT(IN), OPTIONAL :: no_abort !< flag indicating if errors should be checked 3690 LOGICAL, INTENT(IN) :: global !< flag indicating global attribute 4065 3691 #if defined( __netcdf ) 4066 3692 4067 IF ( PRESENT( no_abort ) ) THEN 4068 check_error = no_abort 4069 ELSE 4070 check_error = .TRUE. 4071 ENDIF 4072 ! 4073 !-- Read global attribute 4074 IF ( global ) THEN 4075 nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value ) 4076 IF ( check_error) CALL handle_error( 'get_attribute_int8 global', 523, attribute_name ) 4077 ! 4078 !-- Read attributes referring to a single variable. Therefore, first inquire 4079 !-- variable id 4080 ELSE 4081 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4082 IF ( check_error) CALL handle_error( 'get_attribute_int8', 523, attribute_name ) 4083 nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value ) 4084 IF ( check_error) CALL handle_error( 'get_attribute_int8', 523, attribute_name ) 4085 ENDIF 3693 IF ( PRESENT( no_abort ) ) THEN 3694 check_error = no_abort 3695 ELSE 3696 check_error = .TRUE. 3697 ENDIF 3698 ! 3699 !-- Read global attribute 3700 IF ( global ) THEN 3701 nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value ) 3702 IF ( check_error) CALL handle_error( 'get_attribute_int8 global', 523, attribute_name ) 3703 ! 3704 !-- Read attributes referring to a single variable. Therefore, first inquire variable id 3705 ELSE 3706 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 3707 IF ( check_error) CALL handle_error( 'get_attribute_int8', 523, attribute_name ) 3708 nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value ) 3709 IF ( check_error) CALL handle_error( 'get_attribute_int8', 523, attribute_name ) 3710 ENDIF 4086 3711 #endif 4087 END SUBROUTINE get_attribute_int8 4088 4089 !------------------------------------------------------------------------------! 3712 3713 END SUBROUTINE get_attribute_int8 3714 3715 3716 !--------------------------------------------------------------------------------------------------! 4090 3717 ! Description: 4091 3718 ! ------------ 4092 3719 !> Reads global or variable-related attributes of type REAL 4093 !------------------------------------------------------------------------------! 4094 SUBROUTINE get_attribute_real( id, attribute_name, value, global, & 4095 variable_name, no_abort ) 4096 4097 USE pegrid 4098 4099 IMPLICIT NONE 4100 4101 CHARACTER(LEN=*) :: attribute_name !< attribute name 4102 CHARACTER(LEN=*), OPTIONAL :: variable_name !< variable name 4103 4104 INTEGER(iwp), INTENT(IN) :: id !< file id 4105 INTEGER(iwp) :: id_var !< variable id 4106 4107 LOGICAL :: check_error !< flag indicating if handle_error shall be checked 4108 LOGICAL, INTENT(IN) :: global !< flag indicating global attribute 4109 LOGICAL, INTENT(IN), OPTIONAL :: no_abort !< flag indicating if errors should be checked 4110 4111 REAL(wp), INTENT(INOUT) :: value !< read value 3720 !--------------------------------------------------------------------------------------------------! 3721 SUBROUTINE get_attribute_real( id, attribute_name, value, global, variable_name, no_abort ) 3722 3723 USE pegrid 3724 3725 IMPLICIT NONE 3726 3727 CHARACTER(LEN=*) :: attribute_name !< attribute name 3728 CHARACTER(LEN=*), OPTIONAL :: variable_name !< variable name 3729 3730 INTEGER(iwp), INTENT(IN) :: id !< file id 3731 INTEGER(iwp) :: id_var !< variable id 3732 3733 LOGICAL :: check_error !< flag indicating if handle_error shall be checked 3734 LOGICAL, INTENT(IN) :: global !< flag indicating global attribute 3735 LOGICAL, INTENT(IN), OPTIONAL :: no_abort !< flag indicating if errors should be checked 3736 3737 REAL(wp), INTENT(INOUT) :: value !< read value 4112 3738 #if defined( __netcdf ) 4113 3739 4114 IF ( PRESENT( no_abort ) ) THEN 4115 check_error = no_abort 4116 ELSE 4117 check_error = .TRUE. 4118 ENDIF 4119 ! 4120 !-- Read global attribute 4121 IF ( global ) THEN 4122 nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value ) 4123 IF ( check_error) CALL handle_error( 'get_attribute_real global', 524, attribute_name ) 4124 ! 4125 !-- Read attributes referring to a single variable. Therefore, first inquire 4126 !-- variable id 4127 ELSE 4128 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4129 IF ( check_error) CALL handle_error( 'get_attribute_real', 524, attribute_name ) 4130 nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value ) 4131 IF ( check_error) CALL handle_error( 'get_attribute_real', 524, attribute_name ) 4132 ENDIF 3740 IF ( PRESENT( no_abort ) ) THEN 3741 check_error = no_abort 3742 ELSE 3743 check_error = .TRUE. 3744 ENDIF 3745 ! 3746 !-- Read global attribute 3747 IF ( global ) THEN 3748 nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value ) 3749 IF ( check_error) CALL handle_error( 'get_attribute_real global', 524, attribute_name ) 3750 ! 3751 !-- Read attributes referring to a single variable. Therefore, first inquire variable id 3752 ELSE 3753 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 3754 IF ( check_error) CALL handle_error( 'get_attribute_real', 524, attribute_name ) 3755 nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value ) 3756 IF ( check_error) CALL handle_error( 'get_attribute_real', 524, attribute_name ) 3757 ENDIF 4133 3758 #endif 4134 END SUBROUTINE get_attribute_real 4135 4136 !------------------------------------------------------------------------------! 3759 3760 END SUBROUTINE get_attribute_real 3761 3762 3763 !--------------------------------------------------------------------------------------------------! 4137 3764 ! Description: 4138 3765 ! ------------ … … 4140 3767 !> Remark: reading attributes of type NF_STRING return an error code 56 - 4141 3768 !> Attempt to convert between text & numbers. 4142 !------------------------------------------------------------------------------! 4143 SUBROUTINE get_attribute_string( id, attribute_name, value, global, & 4144 variable_name, no_abort ) 4145 4146 USE pegrid 4147 4148 IMPLICIT NONE 4149 4150 CHARACTER(LEN=*) :: attribute_name !< attribute name 4151 CHARACTER(LEN=*), OPTIONAL :: variable_name !< variable name 4152 CHARACTER(LEN=*), INTENT(INOUT) :: value !< read value 4153 4154 INTEGER(iwp), INTENT(IN) :: id !< file id 4155 INTEGER(iwp) :: id_var !< variable id 4156 4157 LOGICAL :: check_error !< flag indicating if handle_error shall be checked 4158 LOGICAL, INTENT(IN) :: global !< flag indicating global attribute 4159 LOGICAL, INTENT(IN), OPTIONAL :: no_abort !< flag indicating if errors should be checked 3769 !--------------------------------------------------------------------------------------------------! 3770 SUBROUTINE get_attribute_string( id, attribute_name, value, global, variable_name, no_abort ) 3771 3772 USE pegrid 3773 3774 IMPLICIT NONE 3775 3776 CHARACTER(LEN=*) :: attribute_name !< attribute name 3777 CHARACTER(LEN=*), INTENT(INOUT) :: value !< read value 3778 CHARACTER(LEN=*), OPTIONAL :: variable_name !< variable name 3779 3780 INTEGER(iwp), INTENT(IN) :: id !< file id 3781 INTEGER(iwp) :: id_var !< variable id 3782 3783 LOGICAL :: check_error !< flag indicating if handle_error shall be checked 3784 LOGICAL, INTENT(IN) :: global !< flag indicating global attribute 3785 LOGICAL, INTENT(IN), OPTIONAL :: no_abort !< flag indicating if errors should be checked 4160 3786 #if defined( __netcdf ) 4161 3787 4162 IF ( PRESENT( no_abort ) ) THEN 4163 check_error = no_abort 4164 ELSE 4165 check_error = .TRUE. 4166 ENDIF 4167 ! 4168 !-- Read global attribute 4169 IF ( global ) THEN 4170 nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value ) 4171 IF ( check_error) CALL handle_error( 'get_attribute_string global', 525, attribute_name ) 4172 ! 4173 !-- Read attributes referring to a single variable. Therefore, first inquire 4174 !-- variable id 4175 ELSE 4176 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4177 IF ( check_error) CALL handle_error( 'get_attribute_string', 525, attribute_name ) 4178 4179 nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value ) 4180 IF ( check_error) CALL handle_error( 'get_attribute_string',525, attribute_name ) 4181 4182 ENDIF 3788 IF ( PRESENT( no_abort ) ) THEN 3789 check_error = no_abort 3790 ELSE 3791 check_error = .TRUE. 3792 ENDIF 3793 ! 3794 !-- Read global attribute 3795 IF ( global ) THEN 3796 nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value ) 3797 IF ( check_error) CALL handle_error( 'get_attribute_string global', 525, attribute_name ) 3798 ! 3799 !-- Read attributes referring to a single variable. Therefore, first inquire variable id 3800 ELSE 3801 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 3802 IF ( check_error) CALL handle_error( 'get_attribute_string', 525, attribute_name ) 3803 3804 nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value ) 3805 IF ( check_error) CALL handle_error( 'get_attribute_string',525, attribute_name ) 3806 3807 ENDIF 4183 3808 #endif 4184 END SUBROUTINE get_attribute_string 4185 4186 4187 4188 !------------------------------------------------------------------------------ !3809 3810 END SUBROUTINE get_attribute_string 3811 3812 3813 !--------------------------------------------------------------------------------------------------! 4189 3814 ! Description: 4190 3815 ! ------------ 4191 3816 !> Get dimension array for a given dimension 4192 !------------------------------------------------------------------------------ !4193 4194 4195 4196 4197 4198 CHARACTER(LEN=*) :: variable_name !< dimension name4199 CHARACTER(LEN=100) :: dum !< dummy variable to receive return character4200 4201 4202 4203 3817 !--------------------------------------------------------------------------------------------------! 3818 SUBROUTINE get_dimension_length( id, dim_len, variable_name ) 3819 USE pegrid 3820 3821 IMPLICIT NONE 3822 3823 CHARACTER(LEN=100) :: dum !< dummy variable to receive return character 3824 CHARACTER(LEN=*) :: variable_name !< dimension name 3825 3826 INTEGER(iwp) :: dim_len !< dimension size 3827 INTEGER(iwp), INTENT(IN) :: id !< file id 3828 INTEGER(iwp) :: id_dim !< dimension id 4204 3829 4205 3830 #if defined( __netcdf ) 4206 3831 ! 4207 !-- 4208 4209 4210 ! 4211 !-- 4212 4213 3832 !-- First, inquire dimension ID 3833 nc_stat = NF90_INQ_DIMID( id, TRIM( variable_name ), id_dim ) 3834 CALL handle_error( 'get_dimension_length', 526, variable_name ) 3835 ! 3836 !-- Inquire dimension length 3837 nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim, dum, LEN = dim_len ) 3838 CALL handle_error( 'get_dimension_length', 526, variable_name ) 4214 3839 4215 3840 #endif 4216 END SUBROUTINE get_dimension_length 4217 4218 !------------------------------------------------------------------------------! 3841 3842 END SUBROUTINE get_dimension_length 3843 3844 3845 !--------------------------------------------------------------------------------------------------! 4219 3846 ! Description: 4220 3847 ! ------------ 4221 !> Routine for reading-in a character string from the chem emissions netcdf 4222 !> input file. 4223 !------------------------------------------------------------------------------! 4224 4225 SUBROUTINE get_variable_string( id, variable_name, var_string, names_number ) 4226 4227 USE indices 4228 USE pegrid 4229 4230 IMPLICIT NONE 4231 4232 CHARACTER (LEN=25), ALLOCATABLE, DIMENSION(:), INTENT(INOUT) :: var_string 4233 4234 CHARACTER(LEN=*) :: variable_name !> variable name 4235 4236 CHARACTER (LEN=1), ALLOCATABLE, DIMENSION(:,:) :: tmp_var_string !> variable to be read 4237 4238 4239 INTEGER(iwp), INTENT(IN) :: id !> file id 4240 4241 INTEGER(iwp), INTENT(IN) :: names_number !> number of names 4242 4243 INTEGER(iwp) :: id_var !> variable id 4244 4245 INTEGER(iwp) :: i,j !> index to go through the length of the dimensions 4246 4247 INTEGER(iwp) :: max_string_length=25 !> this is both the maximum length of a name, but also 4248 ! the number of the components of the first dimensions 4249 ! (rows) 3848 !> Routine for reading-in a character string from the chem emissions netcdf input file. 3849 !--------------------------------------------------------------------------------------------------! 3850 SUBROUTINE get_variable_string( id, variable_name, var_string, names_number ) 3851 3852 USE indices 3853 USE pegrid 3854 3855 IMPLICIT NONE 3856 3857 CHARACTER (LEN=*) :: variable_name !< variable name 3858 CHARACTER (LEN=25), ALLOCATABLE, DIMENSION(:), INTENT(INOUT) :: var_string 3859 CHARACTER (LEN=1), ALLOCATABLE, DIMENSION(:,:) :: tmp_var_string !< variable to be read 3860 3861 INTEGER(iwp) :: i,j !< index to go through the length of the dimensions 3862 INTEGER(iwp), INTENT(IN) :: id !< file id 3863 INTEGER(iwp) :: id_var !< variable id 3864 INTEGER(iwp), INTENT(IN) :: names_number !< number of names 3865 INTEGER(iwp) :: max_string_length=25 !< this is both the maximum length of a name, but also the number of the 3866 !< components of the first dimensions (rows) 4250 3867 #if defined( __netcdf ) 4251 3868 4252 ALLOCATE(tmp_var_string(max_string_length,names_number)) 4253 4254 ALLOCATE(var_string(names_number)) 4255 4256 !-- Inquire variable id 4257 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4258 4259 4260 !-- Get variable 4261 !-- Start cycle over the emission species 4262 DO i = 1, names_number 4263 !-- read the first letter of each component 4264 nc_stat = NF90_GET_VAR( id, id_var, var_string(i), start = (/ 1,i /), & 4265 count = (/ 1,1 /) ) 4266 CALL handle_error( 'get_variable_string', 701 ) 4267 4268 !-- Start cycle over charachters 4269 DO j = 1, max_string_length 4270 4271 !-- read the rest of the components of the name 4272 nc_stat = NF90_GET_VAR( id, id_var, tmp_var_string(j,i), start = (/ j,i /),& 4273 count = (/ 1,1 /) ) 4274 CALL handle_error( 'get_variable_string', 702 ) 4275 4276 IF ( iachar(tmp_var_string(j,i) ) == 0 ) THEN 4277 tmp_var_string(j,i)='' 4278 ENDIF 4279 4280 IF ( j>1 ) THEN 4281 !-- Concatenate first letter of the name and the others 4282 var_string(i)=TRIM(var_string(i)) // TRIM(tmp_var_string(j,i)) 4283 4284 ENDIF 4285 ENDDO 3869 ALLOCATE( tmp_var_string(max_string_length,names_number) ) 3870 3871 ALLOCATE( var_string(names_number) ) 3872 3873 !-- Inquire variable id 3874 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 3875 3876 ! 3877 !-- Get variable 3878 !-- Start cycle over the emission species 3879 DO i = 1, names_number 3880 ! 3881 !-- Read the first letter of each component 3882 nc_stat = NF90_GET_VAR( id, id_var, var_string(i), start = (/ 1,i /), count = (/ 1,1 /) ) 3883 CALL handle_error( 'get_variable_string', 701 ) 3884 ! 3885 !-- Start cycle over charachters 3886 DO j = 1, max_string_length 3887 ! 3888 !-- Read the rest of the components of the name 3889 nc_stat = NF90_GET_VAR( id, id_var, tmp_var_string(j,i), start = (/ j,i /), & 3890 count = (/ 1,1 /) ) 3891 CALL handle_error( 'get_variable_string', 702 ) 3892 3893 IF ( IACHAR( tmp_var_string(j,i) ) == 0 ) THEN 3894 tmp_var_string(j,i)='' 3895 ENDIF 3896 3897 IF ( j>1 ) THEN 3898 ! 3899 !-- Concatenate first letter of the name and the others 3900 var_string(i)=TRIM( var_string(i) ) // TRIM( tmp_var_string(j,i) ) 3901 ENDIF 4286 3902 ENDDO 3903 ENDDO 4287 3904 4288 3905 #endif 4289 END SUBROUTINE get_variable_string 4290 4291 4292 ! 4293 !------------------------------------------------------------------------------! 3906 3907 END SUBROUTINE get_variable_string 3908 3909 3910 ! 3911 !--------------------------------------------------------------------------------------------------! 4294 3912 ! Description: 4295 3913 ! ------------ 4296 !> Generalized routine for reading strings from a netCDF variable 4297 !> to replace existingget_variable_string ( )3914 !> Generalized routine for reading strings from a netCDF variable to replace existing 3915 !> get_variable_string ( ) 4298 3916 !> 4299 3917 !> Improvements: 4300 3918 !> - Expanded string size limit from 25 to 512 4301 !> - No longer removes spaces between text magically (this seems to have 4302 !> been aimed at a veryspecific application, but I don't know what)3919 !> - No longer removes spaces between text magically (this seems to have been aimed at a very 3920 !> specific application, but I don't know what) 4303 3921 !> - Simplified implementation 4304 3922 !> 4305 3923 !> Caveats: 4306 !> - Somehow I could not get the subroutine to work with str_array(:,:) 4307 !> so I reverted to a hard-coded str_array(:,512), hopefully large enough 4308 !> for most general applications. This also means the character variable 4309 !> used for str_array must be of size (:,512) 4310 !> (ecc 20200128) 4311 !------------------------------------------------------------------------------! 4312 3924 !> - Somehow I could not get the subroutine to work with str_array(:,:) so I reverted to a 3925 !> hard-coded str_array(:,512), hopefully large enough for most general applications. This also 3926 !> means the character variable used for str_array must be of size (:,512) 3927 !> (ecc 20200128) 3928 !--------------------------------------------------------------------------------------------------! 4313 3929 SUBROUTINE get_variable_string_generic ( id, var_name, str_array, num_str, str_len ) 4314 3930 4315 3931 IMPLICIT NONE 4316 3932 4317 CHARACTER(LEN=*), INTENT(IN) :: var_name !> netCDF variable name 4318 CHARACTER(LEN=512), ALLOCATABLE, INTENT(INOUT) :: str_array(:) !> output string array 4319 4320 INTEGER(iwp) :: buf_len !> string buffer size 4321 INTEGER(iwp) :: id_var !> netCDF variable ID 4322 INTEGER(iwp) :: k !> generic counter 4323 4324 INTEGER(iwp), INTENT(IN) :: id !> netCDF file ID 4325 INTEGER(iwp), INTENT(IN) :: num_str !> number of string elements in array 4326 INTEGER(iwp), INTENT(IN) :: str_len !> size of each string element 3933 CHARACTER(LEN=*), INTENT(IN) :: var_name !< netCDF variable name 3934 CHARACTER(LEN=512), ALLOCATABLE, INTENT(INOUT) :: str_array(:) !< output string array 3935 3936 INTEGER(iwp) :: buf_len !< string buffer size 3937 INTEGER(iwp) :: id_var !< netCDF variable ID 3938 INTEGER(iwp), INTENT(IN) :: id !< netCDF file ID 3939 INTEGER(iwp) :: k !< generic counter 3940 INTEGER(iwp), INTENT(IN) :: num_str !< number of string elements in array 3941 INTEGER(iwp), INTENT(IN) :: str_len !< size of each string element 4327 3942 4328 3943 #if defined( __netcdf ) 4329 3944 4330 3945 ! 4331 !-- set buffer length to up to hard-coded string size 4332 3946 !-- Set buffer length to up to hard-coded string size 4333 3947 buf_len = MIN( ABS(str_len), 512 ) 4334 3948 4335 3949 ! 4336 !-- allocate necessary memories for string variables 4337 4338 ALLOCATE(str_array(num_str)) 4339 ! 4340 !-- get variable id 4341 3950 !-- Allocate necessary memories for string variables 3951 ALLOCATE( str_array(num_str) ) 3952 ! 3953 !-- Get variable id 4342 3954 nc_stat = NF90_INQ_VARID( id, TRIM(var_name), id_var ) 4343 3955 ! 4344 !-- extract string variables 4345 4346 DO k = 1, num_str 3956 !-- Extract string variables 3957 DO k = 1, num_str 4347 3958 str_array(k) = '' 4348 nc_stat = NF90_GET_VAR( id, id_var, str_array(k), &4349 start = (/ 1, k /),count = (/ buf_len, 1 /) )3959 nc_stat = NF90_GET_VAR( id, id_var, str_array(k), start = (/ 1, k /), & 3960 count = (/ buf_len, 1 /) ) 4350 3961 CALL handle_error ( 'get_variable_string_generic', 702 ) 4351 3962 ENDDO … … 4356 3967 4357 3968 4358 !------------------------------------------------------------------------------ !3969 !--------------------------------------------------------------------------------------------------! 4359 3970 ! Description: 4360 3971 ! ------------ 4361 3972 !> Reads a character variable in a 1D array 4362 !------------------------------------------------------------------------------! 4363 SUBROUTINE get_variable_1d_char( id, variable_name, var ) 4364 4365 USE pegrid 4366 4367 IMPLICIT NONE 4368 4369 CHARACTER(LEN=*) :: variable_name !< variable name 4370 CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: var !< variable to be read 4371 4372 INTEGER(iwp) :: i !< running index over variable dimension 4373 INTEGER(iwp), INTENT(IN) :: id !< file id 4374 INTEGER(iwp) :: id_var !< dimension id 4375 4376 INTEGER(iwp), DIMENSION(2) :: dimid !< dimension IDs 4377 INTEGER(iwp), DIMENSION(2) :: dimsize !< dimension size 3973 !--------------------------------------------------------------------------------------------------! 3974 SUBROUTINE get_variable_1d_char( id, variable_name, var ) 3975 3976 USE pegrid 3977 3978 IMPLICIT NONE 3979 3980 CHARACTER(LEN=*) :: variable_name !< variable name 3981 3982 CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: var !< variable to be read 3983 3984 INTEGER(iwp) :: i !< running index over variable dimension 3985 INTEGER(iwp), INTENT(IN) :: id !< file id 3986 INTEGER(iwp) :: id_var !< dimension id 3987 3988 INTEGER(iwp), DIMENSION(2) :: dimid !< dimension IDs 3989 INTEGER(iwp), DIMENSION(2) :: dimsize !< dimension size 4378 3990 4379 3991 #if defined( __netcdf ) 4380 3992 4381 3993 ! 4382 !-- First, inquire variable ID 4383 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4384 CALL handle_error( 'get_variable_1d_int', 527, variable_name ) 4385 ! 4386 !-- Inquire dimension IDs 4387 nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, dimids = dimid(1:2) ) 3994 !-- First, inquire variable ID 3995 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 3996 CALL handle_error( 'get_variable_1d_int', 527, variable_name ) 3997 ! 3998 !-- Inquire dimension IDs 3999 nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, dimids = dimid(1:2) ) 4000 CALL handle_error( 'get_variable_1d_char', 527, variable_name ) 4001 ! 4002 !-- Read dimesnion length 4003 nc_stat = NF90_INQUIRE_DIMENSION( id, dimid(1), LEN = dimsize(1) ) 4004 nc_stat = NF90_INQUIRE_DIMENSION( id, dimid(2), LEN = dimsize(2) ) 4005 4006 ! 4007 !-- Read character array. Note, each element is read individually, in order to better separate 4008 !-- single strings. 4009 DO i = 1, dimsize(2) 4010 nc_stat = NF90_GET_VAR( id, id_var, var(i), & 4011 start = (/ 1, i /), & 4012 count = (/ dimsize(1), 1 /) ) 4388 4013 CALL handle_error( 'get_variable_1d_char', 527, variable_name ) 4389 ! 4390 !-- Read dimesnion length 4391 nc_stat = NF90_INQUIRE_DIMENSION( id, dimid(1), LEN = dimsize(1) ) 4392 nc_stat = NF90_INQUIRE_DIMENSION( id, dimid(2), LEN = dimsize(2) ) 4393 4394 ! 4395 !-- Read character array. Note, each element is read individually, in order 4396 !-- to better separate single strings. 4397 DO i = 1, dimsize(2) 4398 nc_stat = NF90_GET_VAR( id, id_var, var(i), & 4399 start = (/ 1, i /), & 4400 count = (/ dimsize(1), 1 /) ) 4401 CALL handle_error( 'get_variable_1d_char', 527, variable_name ) 4402 ENDDO 4403 4014 ENDDO 4015 4404 4016 #endif 4405 END SUBROUTINE get_variable_1d_char 4406 4407 4408 !------------------------------------------------------------------------------! 4017 4018 END SUBROUTINE get_variable_1d_char 4019 4020 4021 !--------------------------------------------------------------------------------------------------! 4409 4022 ! Description: 4410 4023 ! ------------ 4411 4024 !> Reads a 1D integer variable from file. 4412 !------------------------------------------------------------------------------ !4413 4414 4415 4416 4417 4418 4419 4420 4421 4422 4423 4424 4025 !--------------------------------------------------------------------------------------------------! 4026 SUBROUTINE get_variable_1d_int( id, variable_name, var ) 4027 4028 USE pegrid 4029 4030 IMPLICIT NONE 4031 4032 CHARACTER(LEN=*) :: variable_name !< variable name 4033 4034 INTEGER(iwp), INTENT(IN) :: id !< file id 4035 INTEGER(iwp) :: id_var !< dimension id 4036 4037 INTEGER(iwp), DIMENSION(:), INTENT(INOUT) :: var !< variable to be read 4425 4038 #if defined( __netcdf ) 4426 4039 4427 4040 ! 4428 !-- 4429 4430 4431 ! 4432 !-- 4433 4434 4041 !-- First, inquire variable ID 4042 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4043 CALL handle_error( 'get_variable_1d_int', 527, variable_name ) 4044 ! 4045 !-- Read variable 4046 nc_stat = NF90_GET_VAR( id, id_var, var ) 4047 CALL handle_error( 'get_variable_1d_int', 527, variable_name ) 4435 4048 4436 4049 #endif 4437 END SUBROUTINE get_variable_1d_int 4438 4439 !------------------------------------------------------------------------------! 4050 4051 END SUBROUTINE get_variable_1d_int 4052 4053 4054 !--------------------------------------------------------------------------------------------------! 4440 4055 ! Description: 4441 4056 ! ------------ 4442 4057 !> Reads a 1D float variable from file. 4443 !------------------------------------------------------------------------------! 4444 SUBROUTINE get_variable_1d_real( id, variable_name, var, is, count_elements ) 4445 4446 USE pegrid 4447 4448 IMPLICIT NONE 4449 4450 CHARACTER(LEN=*) :: variable_name !< variable name 4451 4452 INTEGER(iwp), INTENT(IN) :: id !< file id 4453 INTEGER(iwp) :: id_var !< dimension id 4454 4455 INTEGER(iwp), INTENT(IN), OPTIONAL :: count_elements !< number of elements to be read 4456 INTEGER(iwp), INTENT(IN), OPTIONAL :: is !< start index 4457 4458 REAL(wp), DIMENSION(:), INTENT(INOUT) :: var !< variable to be read 4058 !--------------------------------------------------------------------------------------------------! 4059 SUBROUTINE get_variable_1d_real( id, variable_name, var, is, count_elements ) 4060 4061 USE pegrid 4062 4063 IMPLICIT NONE 4064 4065 CHARACTER(LEN=*) :: variable_name !< variable name 4066 4067 INTEGER(iwp), INTENT(IN), OPTIONAL :: count_elements !< number of elements to be read 4068 INTEGER(iwp), INTENT(IN) :: id !< file id 4069 INTEGER(iwp) :: id_var !< dimension id 4070 INTEGER(iwp), INTENT(IN), OPTIONAL :: is !< start index 4071 4072 REAL(wp), DIMENSION(:), INTENT(INOUT) :: var !< variable to be read 4459 4073 #if defined( __netcdf ) 4460 4074 ! 4461 !-- First, inquire variable ID 4462 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4075 !-- First, inquire variable ID 4076 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4077 CALL handle_error( 'get_variable_1d_real', 528, variable_name ) 4078 ! 4079 !-- Read variable 4080 IF ( PRESENT( is ) ) THEN 4081 nc_stat = NF90_GET_VAR( id, id_var, var, start = (/ is /), count = (/ count_elements /) ) 4463 4082 CALL handle_error( 'get_variable_1d_real', 528, variable_name ) 4464 ! 4465 !-- Read variable 4466 IF ( PRESENT( is ) ) THEN 4467 nc_stat = NF90_GET_VAR( id, id_var, var, start = (/ is /), count = (/ count_elements /) ) 4468 CALL handle_error( 'get_variable_1d_real', 528, variable_name ) 4469 ELSE 4470 nc_stat = NF90_GET_VAR( id, id_var, var ) 4471 CALL handle_error( 'get_variable_1d_real', 528, variable_name ) 4472 ENDIF 4083 ELSE 4084 nc_stat = NF90_GET_VAR( id, id_var, var ) 4085 CALL handle_error( 'get_variable_1d_real', 528, variable_name ) 4086 ENDIF 4473 4087 4474 4088 #endif 4475 END SUBROUTINE get_variable_1d_real 4476 4477 4478 !------------------------------------------------------------------------------! 4089 4090 END SUBROUTINE get_variable_1d_real 4091 4092 4093 !--------------------------------------------------------------------------------------------------! 4479 4094 ! Description: 4480 4095 ! ------------ 4481 4096 !> Reads a time-dependent 1D float variable from file. 4482 !------------------------------------------------------------------------------ !4483 4484 4485 4486 4487 4488 4489 4490 4491 4492 4493 4494 4495 4496 4497 4097 !--------------------------------------------------------------------------------------------------! 4098 SUBROUTINE get_variable_pr( id, variable_name, t, var ) 4099 4100 USE pegrid 4101 4102 IMPLICIT NONE 4103 4104 CHARACTER(LEN=*) :: variable_name !< variable name 4105 4106 INTEGER(iwp), INTENT(IN) :: id !< file id 4107 INTEGER(iwp), DIMENSION(1:2) :: id_dim !< dimension ids 4108 INTEGER(iwp) :: id_var !< dimension id 4109 INTEGER(iwp) :: n_file !< number of data-points in file along z dimension 4110 INTEGER(iwp), INTENT(IN) :: t !< timestep number 4111 4112 REAL(wp), DIMENSION(:), INTENT(INOUT) :: var !< variable to be read 4498 4113 4499 4114 #if defined( __netcdf ) 4500 4115 ! 4501 !-- First, inquire variable ID 4502 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4503 ! 4504 !-- Inquire dimension size of vertical dimension 4505 nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, DIMIDS = id_dim ) 4506 nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(1), LEN = n_file ) 4507 ! 4508 !-- Read variable. 4509 nc_stat = NF90_GET_VAR( id, id_var, var, & 4510 start = (/ 1, t /), & 4511 count = (/ n_file, 1 /) ) 4512 CALL handle_error( 'get_variable_pr', 529, variable_name ) 4513 4116 !-- First, inquire variable ID 4117 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4118 ! 4119 !-- Inquire dimension size of vertical dimension 4120 nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, DIMIDS = id_dim ) 4121 nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(1), LEN = n_file ) 4122 ! 4123 !-- Read variable. 4124 nc_stat = NF90_GET_VAR( id, id_var, var, & 4125 start = (/ 1, t /), & 4126 count = (/ n_file, 1 /) ) 4127 CALL handle_error( 'get_variable_pr', 529, variable_name ) 4514 4128 #endif 4515 END SUBROUTINE get_variable_pr 4516 4517 4518 !------------------------------------------------------------------------------! 4129 4130 END SUBROUTINE get_variable_pr 4131 4132 4133 !--------------------------------------------------------------------------------------------------! 4519 4134 ! Description: 4520 4135 ! ------------ 4521 !> Reads a per-surface pars variable from file. Because all surfaces are stored 4522 !> as flat 1-D array, each PE has to scan the data and find the surface indices 4523 !> belonging to its subdomain. During this scan, it also builds a necessary 4524 !> (j,i) index. 4525 !------------------------------------------------------------------------------! 4526 SUBROUTINE get_variable_surf( id, variable_name, surf ) 4527 4528 USE pegrid 4529 4530 USE indices, & 4531 ONLY: nxl, nxr, nys, nyn 4532 4533 USE control_parameters, & 4534 ONLY: dz, message_string 4535 4536 USE grid_variables, & 4537 ONLY: dx, dy 4538 4539 USE basic_constants_and_equations_mod, & 4540 ONLY: pi 4541 4542 IMPLICIT NONE 4543 4544 INTEGER(iwp), PARAMETER :: nsurf_pars_read = 2**15 !< read buffer size (value > 10^15 makes problem with ifort) 4545 4546 CHARACTER(LEN=*) :: variable_name !< variable name 4547 4548 INTEGER(iwp), DIMENSION(6) :: coords !< integer coordinates of surface 4549 INTEGER(iwp) :: i, j 4550 INTEGER(iwp) :: isurf !< netcdf surface index 4551 INTEGER(iwp) :: is !< local surface index 4552 INTEGER(iwp), INTENT(IN) :: id !< file id 4553 INTEGER(iwp), DIMENSION(2) :: id_dim !< dimension ids 4554 INTEGER(iwp) :: id_var !< variable id 4555 INTEGER(iwp) :: id_zs !< zs variable id 4556 INTEGER(iwp) :: id_ys !< ys variable id 4557 INTEGER(iwp) :: id_xs !< xs variable id 4558 INTEGER(iwp) :: id_zenith !< zeith variable id 4559 INTEGER(iwp) :: id_azimuth !< azimuth variable id 4560 INTEGER(iwp) :: is0, isc !< read surface start and count 4561 INTEGER(iwp) :: nsurf !< total number of surfaces in file 4562 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: nsurf_ji !< numbers of surfaces by coords 4563 4564 TYPE(pars_surf) :: surf !< parameters variable to be loaded 4565 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pars_read !< read buffer 4566 REAL(wp), DIMENSION(:), ALLOCATABLE :: zs, ys, xs !< read buffer for zs(s), ys, xs 4567 REAL(wp), DIMENSION(:), ALLOCATABLE :: zenith !< read buffer for zenith(s) 4568 REAL(wp), DIMENSION(:), ALLOCATABLE :: azimuth !< read buffer for azimuth(s) 4569 REAL(wp) :: oro_max_l !< maximum terrain height under building 4136 !> Reads a per-surface pars variable from file. Because all surfaces are stored as flat 1-D array, 4137 !> each PE has to scan the data and find the surface indices belonging to its subdomain. During this 4138 !> scan, it also builds a necessary (j,i) index. 4139 !--------------------------------------------------------------------------------------------------! 4140 SUBROUTINE get_variable_surf( id, variable_name, surf ) 4141 4142 USE pegrid 4143 4144 USE indices, & 4145 ONLY: nxl, nxr, nys, nyn 4146 4147 USE control_parameters, & 4148 ONLY: dz, message_string 4149 4150 USE grid_variables, & 4151 ONLY: dx, dy 4152 4153 USE basic_constants_and_equations_mod, & 4154 ONLY: pi 4155 4156 IMPLICIT NONE 4157 4158 INTEGER(iwp), PARAMETER :: nsurf_pars_read = 2**15 !< read buffer size (value > 10^15 makes problem with 4159 !< ifort) 4160 4161 CHARACTER(LEN=*) :: variable_name !< variable name 4162 4163 INTEGER(iwp) :: i, j 4164 INTEGER(iwp), INTENT(IN) :: id !< file id 4165 INTEGER(iwp) :: id_azimuth !< azimuth variable id 4166 INTEGER(iwp) :: id_var !< variable id 4167 INTEGER(iwp) :: id_xs !< xs variable id 4168 INTEGER(iwp) :: id_ys !< ys variable id 4169 INTEGER(iwp) :: id_zs !< zs variable id 4170 INTEGER(iwp) :: id_zenith !< zeith variable id 4171 INTEGER(iwp) :: is !< local surface index 4172 INTEGER(iwp) :: is0, isc !< read surface start and count 4173 INTEGER(iwp) :: isurf !< netcdf surface index 4174 INTEGER(iwp) :: nsurf !< total number of surfaces in file 4175 4176 INTEGER(iwp), DIMENSION(6) :: coords !< integer coordinates of surface 4177 INTEGER(iwp), DIMENSION(2) :: id_dim !< dimension ids 4178 4179 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: nsurf_ji !< numbers of surfaces by coords 4180 4181 REAL(wp) :: oro_max_l !< maximum terrain height under building 4182 4183 REAL(wp), DIMENSION(:), ALLOCATABLE :: azimuth !< read buffer for azimuth(s) 4184 REAL(wp), DIMENSION(:), ALLOCATABLE :: zenith !< read buffer for zenith(s) 4185 REAL(wp), DIMENSION(:), ALLOCATABLE :: zs, ys, xs !< read buffer for zs(s), ys, xs 4186 4187 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: pars_read !< read buffer 4188 4189 TYPE(pars_surf) :: surf !< parameters variable to be loaded 4190 4570 4191 4571 4192 #if defined( __netcdf ) 4572 4193 ! 4573 !-- First, inquire variable ID 4574 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4575 nc_stat = NF90_INQ_VARID( id, 'zs', id_zs ) 4576 nc_stat = NF90_INQ_VARID( id, 'ys', id_ys ) 4577 nc_stat = NF90_INQ_VARID( id, 'xs', id_xs ) 4578 nc_stat = NF90_INQ_VARID( id, 'zenith', id_zenith ) 4579 nc_stat = NF90_INQ_VARID( id, 'azimuth', id_azimuth ) 4580 ! 4581 !-- Inquire dimension sizes 4582 nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, DIMIDS = id_dim ) 4583 nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(1), LEN = nsurf ) 4584 nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(2), LEN = surf%np ) 4585 4586 ALLOCATE ( pars_read( nsurf_pars_read, surf%np ), & 4587 zs(nsurf_pars_read), ys(nsurf_pars_read), & 4588 xs(nsurf_pars_read), zenith(nsurf_pars_read), & 4589 azimuth(nsurf_pars_read), & 4590 nsurf_ji(nys:nyn, nxl:nxr) ) 4591 4592 nsurf_ji(:,:) = 0 4593 ! 4594 !-- Scan surface coordinates, count local 4595 is0 = 1 4596 DO 4597 isc = MIN(nsurf_pars_read, nsurf - is0 + 1) 4598 IF ( isc <= 0 ) EXIT 4599 4600 nc_stat = NF90_GET_VAR( id, id_ys, ys, & 4601 start = (/ is0 /), & 4602 count = (/ isc /) ) 4603 nc_stat = NF90_GET_VAR( id, id_xs, xs, & 4604 start = (/ is0 /), & 4605 count = (/ isc /) ) 4606 nc_stat = NF90_GET_VAR( id, id_zenith, zenith, & 4607 start = (/ is0 /), & 4608 count = (/ isc /) ) 4609 nc_stat = NF90_GET_VAR( id, id_azimuth, azimuth, & 4610 start = (/ is0 /), & 4611 count = (/ isc /) ) 4612 CALL handle_error( 'get_variable_surf', 682, 'azimuth' ) 4613 4614 DO isurf = 1, isc 4615 ! 4616 !-- Parse coordinates, detect if belongs to subdomain 4617 coords = transform_coords( xs(isurf), ys(isurf), & 4618 zenith(isurf), azimuth(isurf) ) 4619 IF ( coords(2) < nys .OR. coords(2) > nyn .OR. & 4620 coords(3) < nxl .OR. coords(3) > nxr ) CYCLE 4621 4622 nsurf_ji(coords(2), coords(3)) = nsurf_ji(coords(2), coords(3)) + 1 4623 ENDDO 4624 4625 is0 = is0 + isc 4194 !-- First, inquire variable ID 4195 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4196 nc_stat = NF90_INQ_VARID( id, 'zs', id_zs ) 4197 nc_stat = NF90_INQ_VARID( id, 'ys', id_ys ) 4198 nc_stat = NF90_INQ_VARID( id, 'xs', id_xs ) 4199 nc_stat = NF90_INQ_VARID( id, 'zenith', id_zenith ) 4200 nc_stat = NF90_INQ_VARID( id, 'azimuth', id_azimuth ) 4201 ! 4202 !-- Inquire dimension sizes 4203 nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, DIMIDS = id_dim ) 4204 nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(1), LEN = nsurf ) 4205 nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(2), LEN = surf%np ) 4206 4207 ALLOCATE( pars_read( nsurf_pars_read, surf%np ), & 4208 zs(nsurf_pars_read), ys(nsurf_pars_read), & 4209 xs(nsurf_pars_read), zenith(nsurf_pars_read), & 4210 azimuth(nsurf_pars_read), & 4211 nsurf_ji(nys:nyn, nxl:nxr) ) 4212 4213 nsurf_ji(:,:) = 0 4214 ! 4215 !-- Scan surface coordinates, count local 4216 is0 = 1 4217 DO 4218 isc = MIN(nsurf_pars_read, nsurf - is0 + 1) 4219 IF ( isc <= 0 ) EXIT 4220 4221 nc_stat = NF90_GET_VAR( id, id_ys, ys, & 4222 start = (/ is0 /), & 4223 count = (/ isc /) ) 4224 nc_stat = NF90_GET_VAR( id, id_xs, xs, & 4225 start = (/ is0 /), & 4226 count = (/ isc /) ) 4227 nc_stat = NF90_GET_VAR( id, id_zenith, zenith, & 4228 start = (/ is0 /), & 4229 count = (/ isc /) ) 4230 nc_stat = NF90_GET_VAR( id, id_azimuth, azimuth, & 4231 start = (/ is0 /), & 4232 count = (/ isc /) ) 4233 CALL handle_error( 'get_variable_surf', 682, 'azimuth' ) 4234 4235 DO isurf = 1, isc 4236 ! 4237 !-- Parse coordinates, detect if belongs to subdomain 4238 coords = transform_coords( xs(isurf), ys(isurf), zenith(isurf), azimuth(isurf) ) 4239 IF ( coords(2) < nys .OR. coords(2) > nyn .OR. & 4240 coords(3) < nxl .OR. coords(3) > nxr ) CYCLE 4241 4242 nsurf_ji(coords(2), coords(3)) = nsurf_ji(coords(2), coords(3)) + 1 4626 4243 ENDDO 4627 ! 4628 !-- Populate reverse index from surface counts 4629 ALLOCATE ( surf%index_ji( 2, nys:nyn, nxl:nxr ) ) 4630 4631 isurf = 14632 DO j = nys, nyn4633 DO i = nxl, nxr4634 surf%index_ji(:,j,i) = (/ isurf, isurf + nsurf_ji(j,i) - 1 /)4635 isurf = isurf + nsurf_ji(j,i)4636 ENDDO4244 is0 = is0 + isc 4245 ENDDO 4246 ! 4247 !-- Populate reverse index from surface counts 4248 ALLOCATE( surf%index_ji( 2, nys:nyn, nxl:nxr ) ) 4249 isurf = 1 4250 DO j = nys, nyn 4251 DO i = nxl, nxr 4252 surf%index_ji(:,j,i) = (/ isurf, isurf + nsurf_ji(j,i) - 1 /) 4253 isurf = isurf + nsurf_ji(j,i) 4637 4254 ENDDO 4638 4639 surf%nsurf = isurf - 1 4640 ALLOCATE( surf%pars( 0:surf%np-1, surf%nsurf ), & 4641 surf%coords( 6, surf%nsurf ) ) 4642 ! 4643 !-- Scan surfaces again, saving pars into allocated structures 4644 nsurf_ji(:,:) = 0 4645 is0 = 1 4646 DO 4647 isc = MIN(nsurf_pars_read, nsurf - is0 + 1) 4648 IF ( isc <= 0 ) EXIT 4649 4650 nc_stat = NF90_GET_VAR( id, id_var, pars_read(1:isc, 1:surf%np), & 4651 start = (/ is0, 1 /), & 4652 count = (/ isc, surf%np /) ) 4653 CALL handle_error( 'get_variable_surf', 683, variable_name ) 4654 4655 nc_stat = NF90_GET_VAR( id, id_zs, zs, & 4656 start = (/ is0 /), & 4657 count = (/ isc /) ) 4658 nc_stat = NF90_GET_VAR( id, id_ys, ys, & 4659 start = (/ is0 /), & 4660 count = (/ isc /) ) 4661 nc_stat = NF90_GET_VAR( id, id_xs, xs, & 4662 start = (/ is0 /), & 4663 count = (/ isc /) ) 4664 nc_stat = NF90_GET_VAR( id, id_zenith, zenith, & 4665 start = (/ is0 /), & 4666 count = (/ isc /) ) 4667 nc_stat = NF90_GET_VAR( id, id_azimuth, azimuth, & 4668 start = (/ is0 /), & 4669 count = (/ isc /) ) 4670 4671 DO isurf = 1, isc 4672 ! 4673 !-- Parse coordinates, detect if belongs to subdomain 4674 coords = transform_coords( xs(isurf), ys(isurf), & 4675 zenith(isurf), azimuth(isurf) ) 4676 IF ( coords(2) < nys .OR. coords(2) > nyn .OR. & 4677 coords(3) < nxl .OR. coords(3) > nxr ) CYCLE 4678 ! 4679 !-- Determine maximum terrain under building (base z-coordinate). Using 4680 !-- normal vector to locate building inner coordinates. 4681 oro_max_l = buildings_f%oro_max(coords(2)-coords(5), coords(3)-coords(6)) 4682 IF ( oro_max_l == buildings_f%fill1 ) THEN 4683 WRITE( message_string, * ) 'Found building surface on ' // & 4684 'non-building coordinates (xs, ys, zenith, azimuth): ', & 4685 xs(isurf), ys(isurf), zenith(isurf), azimuth(isurf) 4686 CALL message( 'get_variable_surf', 'PA0684', 2, 2, myid, 6, 0 ) 4687 ENDIF 4688 ! 4689 !-- Urban layer has no stretching, therefore using dz(1) instead of linear 4690 !-- searching through zu/zw 4691 coords(1) = NINT((zs(isurf) + oro_max_l) / dz(1) + & 4692 0.5_wp + 0.5_wp * coords(4), KIND=iwp) 4693 ! 4694 !-- Save surface entry 4695 is = surf%index_ji(1, coords(2), coords(3)) + nsurf_ji(coords(2), coords(3)) 4696 surf%pars(:,is) = pars_read(isurf,:) 4697 surf%coords(:,is) = coords(:) 4698 4699 nsurf_ji(coords(2), coords(3)) = nsurf_ji(coords(2), coords(3)) + 1 4700 ENDDO 4701 4702 is0 = is0 + isc 4255 ENDDO 4256 4257 surf%nsurf = isurf - 1 4258 ALLOCATE( surf%pars( 0:surf%np-1, surf%nsurf ), & 4259 surf%coords( 6, surf%nsurf ) ) 4260 ! 4261 !-- Scan surfaces again, saving pars into allocated structures 4262 nsurf_ji(:,:) = 0 4263 is0 = 1 4264 DO 4265 isc = MIN(nsurf_pars_read, nsurf - is0 + 1) 4266 IF ( isc <= 0 ) EXIT 4267 4268 nc_stat = NF90_GET_VAR( id, id_var, pars_read(1:isc, 1:surf%np), & 4269 start = (/ is0, 1 /), & 4270 count = (/ isc, surf%np /) ) 4271 CALL handle_error( 'get_variable_surf', 683, variable_name ) 4272 4273 nc_stat = NF90_GET_VAR( id, id_zs, zs, & 4274 start = (/ is0 /), & 4275 count = (/ isc /) ) 4276 nc_stat = NF90_GET_VAR( id, id_ys, ys, & 4277 start = (/ is0 /), & 4278 count = (/ isc /) ) 4279 nc_stat = NF90_GET_VAR( id, id_xs, xs, & 4280 start = (/ is0 /), & 4281 count = (/ isc /) ) 4282 nc_stat = NF90_GET_VAR( id, id_zenith, zenith, & 4283 start = (/ is0 /), & 4284 count = (/ isc /) ) 4285 nc_stat = NF90_GET_VAR( id, id_azimuth, azimuth, & 4286 start = (/ is0 /), & 4287 count = (/ isc /) ) 4288 4289 DO isurf = 1, isc 4290 ! 4291 !-- Parse coordinates, detect if belongs to subdomain 4292 coords = transform_coords( xs(isurf), ys(isurf), zenith(isurf), azimuth(isurf) ) 4293 IF ( coords(2) < nys .OR. coords(2) > nyn .OR. & 4294 coords(3) < nxl .OR. coords(3) > nxr ) CYCLE 4295 ! 4296 !-- Determine maximum terrain under building (base z-coordinate). Using normal vector to 4297 !-- locate building inner coordinates. 4298 oro_max_l = buildings_f%oro_max(coords(2)-coords(5), coords(3)-coords(6)) 4299 IF ( oro_max_l == buildings_f%fill1 ) THEN 4300 WRITE( message_string, * ) 'Found building surface on ' // & 4301 'non-building coordinates (xs, ys, zenith, azimuth): ', & 4302 xs(isurf), ys(isurf), zenith(isurf), azimuth(isurf) 4303 CALL message( 'get_variable_surf', 'PA0684', 2, 2, myid, 6, 0 ) 4304 ENDIF 4305 ! 4306 !-- Urban layer has no stretching, therefore using dz(1) instead of linear searching through 4307 !-- zu/zw. 4308 coords(1) = NINT( ( zs(isurf) + oro_max_l ) / dz(1) + 0.5_wp + 0.5_wp * coords(4), & 4309 KIND=iwp ) 4310 ! 4311 !-- Save surface entry 4312 is = surf%index_ji(1, coords(2), coords(3)) + nsurf_ji(coords(2), coords(3)) 4313 surf%pars(:,is) = pars_read(isurf,:) 4314 surf%coords(:,is) = coords(:) 4315 4316 nsurf_ji(coords(2), coords(3)) = nsurf_ji(coords(2), coords(3)) + 1 4703 4317 ENDDO 4704 4318 4705 DEALLOCATE( pars_read, zs, ys, xs, zenith, azimuth, nsurf_ji ) 4706 4707 CONTAINS 4708 4709 PURE FUNCTION transform_coords( x, y, zenith, azimuth ) 4710 4711 REAL(wp), INTENT(in) :: x, y !< surface centre coordinates in metres from origin 4712 REAL(wp), INTENT(in) :: zenith !< surface normal zenith angle in degrees 4713 REAL(wp), INTENT(in) :: azimuth !< surface normal azimuth angle in degrees 4714 4715 INTEGER(iwp), DIMENSION(6) :: transform_coords !< (k,j,i,norm_z,norm_y,norm_x) 4716 4717 transform_coords(4) = NINT(COS(zenith*pi/180._wp), KIND=iwp) 4718 IF ( transform_coords(4) == 0 ) THEN 4719 transform_coords(5) = NINT(COS(azimuth*pi/180._wp), KIND=iwp) 4720 transform_coords(6) = NINT(SIN(azimuth*pi/180._wp), KIND=iwp) 4721 ELSE 4722 transform_coords(5) = 0._wp 4723 transform_coords(6) = 0._wp 4724 ENDIF 4725 4726 transform_coords(1) = -999._wp ! not calculated here 4727 transform_coords(2) = NINT(y/dy - 0.5_wp + 0.5_wp*transform_coords(5), KIND=iwp) 4728 transform_coords(3) = NINT(x/dx - 0.5_wp + 0.5_wp*transform_coords(6), KIND=iwp) 4729 4730 END FUNCTION transform_coords 4731 4319 is0 = is0 + isc 4320 ENDDO 4321 4322 DEALLOCATE( pars_read, zs, ys, xs, zenith, azimuth, nsurf_ji ) 4323 4324 CONTAINS 4325 4326 PURE FUNCTION transform_coords( x, y, zenith, azimuth ) 4327 4328 INTEGER(iwp), DIMENSION(6) :: transform_coords !< (k,j,i,norm_z,norm_y,norm_x) 4329 4330 REAL(wp), INTENT(in) :: azimuth !< surface normal azimuth angle in degrees 4331 REAL(wp), INTENT(in) :: x, y !< surface centre coordinates in metres from origin 4332 REAL(wp), INTENT(in) :: zenith !< surface normal zenith angle in degrees 4333 4334 transform_coords(4) = NINT( COS( zenith * pi / 180.0_wp ), KIND=iwp ) 4335 IF ( transform_coords(4) == 0 ) THEN 4336 transform_coords(5) = NINT( COS( azimuth * pi / 180.0_wp ), KIND=iwp) 4337 transform_coords(6) = NINT( SIN( azimuth * pi / 180.0_wp ), KIND=iwp) 4338 ELSE 4339 transform_coords(5) = 0.0_wp 4340 transform_coords(6) = 0.0_wp 4341 ENDIF 4342 4343 transform_coords(1) = -999.0_wp ! not calculated here 4344 transform_coords(2) = NINT( y / dy - 0.5_wp + 0.5_wp * transform_coords(5), KIND=iwp ) 4345 transform_coords(3) = NINT( x / dx - 0.5_wp + 0.5_wp * transform_coords(6), KIND=iwp ) 4346 4347 END FUNCTION transform_coords 4732 4348 #endif 4733 END SUBROUTINE get_variable_surf 4734 4735 4736 !------------------------------------------------------------------------------! 4349 4350 END SUBROUTINE get_variable_surf 4351 4352 4353 !--------------------------------------------------------------------------------------------------! 4737 4354 ! Description: 4738 4355 ! ------------ 4739 !> Reads a 2D REAL variable from a file. Reading is done processor-wise, 4740 !> i.e. each core reads its own domain in slices along x. 4741 !------------------------------------------------------------------------------! 4742 SUBROUTINE get_variable_2d_real( id, variable_name, var, is, ie, js, je ) 4743 4744 USE indices 4745 USE pegrid 4746 4747 IMPLICIT NONE 4748 4749 CHARACTER(LEN=*) :: variable_name !< variable name 4750 4751 INTEGER(iwp) :: i !< running index along x direction 4752 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 4753 INTEGER(iwp) :: is !< end index for subdomain input along x direction 4754 INTEGER(iwp), INTENT(IN) :: id !< file id 4755 INTEGER(iwp) :: id_var !< variable id 4756 INTEGER(iwp) :: j !< running index along y direction 4757 INTEGER(iwp) :: je !< start index for subdomain input along y direction 4758 INTEGER(iwp) :: js !< end index for subdomain input along y direction 4759 4760 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4761 !< to its reverse memory access 4762 REAL(wp), DIMENSION(:,:), INTENT(INOUT) :: var !< variable to be read 4356 !> Reads a 2D REAL variable from a file. Reading is done processor-wise, i.e. each core reads its 4357 !> own domain in slices along x. 4358 !--------------------------------------------------------------------------------------------------! 4359 SUBROUTINE get_variable_2d_real( id, variable_name, var, is, ie, js, je ) 4360 4361 USE indices 4362 USE pegrid 4363 4364 IMPLICIT NONE 4365 4366 CHARACTER(LEN=*) :: variable_name !< variable name 4367 4368 INTEGER(iwp) :: i !< running index along x direction 4369 INTEGER(iwp), INTENT(IN) :: id !< file id 4370 INTEGER(iwp) :: id_var !< variable id 4371 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 4372 INTEGER(iwp) :: is !< end index for subdomain input along x direction 4373 INTEGER(iwp) :: j !< running index along y direction 4374 INTEGER(iwp) :: je !< start index for subdomain input along y direction 4375 INTEGER(iwp) :: js !< end index for subdomain input along y direction 4376 4377 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4378 !< to its reverse memory access 4379 REAL(wp), DIMENSION(:,:), INTENT(INOUT) :: var !< variable to be read 4380 4381 4763 4382 #if defined( __netcdf ) 4764 4383 ! 4765 !-- Inquire variable id 4766 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4767 ! 4768 !-- Check for collective read-operation and set respective NetCDF flags if 4769 !-- required. 4770 IF ( collective_read ) THEN 4384 !-- Inquire variable id 4385 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4386 ! 4387 !-- Check for collective read-operation and set respective NetCDF flags if required. 4388 IF ( collective_read ) THEN 4771 4389 #if defined( __netcdf4_parallel ) 4772 4390 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4773 4391 #endif 4774 ENDIF 4775 4776 ! 4777 !-- Allocate temporary variable according to memory access on file. 4778 ALLOCATE( tmp(is:ie,js:je) ) 4779 ! 4780 !-- Get variable 4781 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 4782 start = (/ is+1, js+1 /), & 4783 count = (/ ie-is + 1, je-js+1 /) ) 4784 CALL handle_error( 'get_variable_2d_real', 530, variable_name ) 4785 ! 4786 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4787 DO i = is, ie 4788 DO j = js, je 4789 var(j-js+1,i-is+1) = tmp(i,j) 4790 ENDDO 4392 ENDIF 4393 4394 ! 4395 !-- Allocate temporary variable according to memory access on file. 4396 ALLOCATE( tmp(is:ie,js:je) ) 4397 ! 4398 !-- Get variable 4399 nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ is+1, js+1 /), & 4400 count = (/ ie-is+1, je-js+1 /) ) 4401 CALL handle_error( 'get_variable_2d_real', 530, variable_name ) 4402 ! 4403 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4404 DO i = is, ie 4405 DO j = js, je 4406 var(j-js+1,i-is+1) = tmp(i,j) 4791 4407 ENDDO 4792 4793 DEALLOCATE( tmp ) 4794 4408 ENDDO 4409 4410 DEALLOCATE( tmp ) 4795 4411 #endif 4796 END SUBROUTINE get_variable_2d_real 4797 4798 !------------------------------------------------------------------------------! 4412 4413 END SUBROUTINE get_variable_2d_real 4414 4415 4416 !--------------------------------------------------------------------------------------------------! 4799 4417 ! Description: 4800 4418 ! ------------ 4801 !> Reads a 2D 32-bit INTEGER variable from file. Reading is done processor-wise, 4802 !> i.e. each core reads its own domain in slices along x. 4803 !------------------------------------------------------------------------------! 4804 SUBROUTINE get_variable_2d_int32( id, variable_name, var, is, ie, js, je ) 4805 4806 USE indices 4807 USE pegrid 4808 4809 IMPLICIT NONE 4810 4811 CHARACTER(LEN=*) :: variable_name !< variable name 4812 4813 INTEGER(iwp) :: i !< running index along x direction 4814 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 4815 INTEGER(iwp) :: is !< end index for subdomain input along x direction 4816 INTEGER(iwp), INTENT(IN) :: id !< file id 4817 INTEGER(iwp) :: id_var !< variable id 4818 INTEGER(iwp) :: j !< running index along y direction 4819 INTEGER(iwp) :: je !< start index for subdomain input along y direction 4820 INTEGER(iwp) :: js !< end index for subdomain input along y direction 4821 4822 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4823 !< to its reverse memory access 4824 INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT) :: var !< variable to be read 4419 !> Reads a 2D 32-bit INTEGER variable from file. Reading is done processor-wise, i.e. each core 4420 !> reads its own domain in slices along x. 4421 !--------------------------------------------------------------------------------------------------! 4422 SUBROUTINE get_variable_2d_int32( id, variable_name, var, is, ie, js, je ) 4423 4424 USE indices 4425 USE pegrid 4426 4427 IMPLICIT NONE 4428 4429 CHARACTER(LEN=*) :: variable_name !< variable name 4430 4431 INTEGER(iwp) :: i !< running index along x direction 4432 INTEGER(iwp), INTENT(IN) :: id !< file id 4433 INTEGER(iwp) :: id_var !< variable id 4434 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 4435 INTEGER(iwp) :: is !< end index for subdomain input along x direction 4436 INTEGER(iwp) :: j !< running index along y direction 4437 INTEGER(iwp) :: je !< start index for subdomain input along y direction 4438 INTEGER(iwp) :: js !< end index for subdomain input along y direction 4439 4440 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4441 !< to its reverse memory access 4442 INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT) :: var !< variable to be read 4443 4444 4825 4445 #if defined( __netcdf ) 4826 4446 ! 4827 !-- Inquire variable id 4828 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4829 ! 4830 !-- Check for collective read-operation and set respective NetCDF flags if 4831 !-- required. 4832 IF ( collective_read ) THEN 4833 #if defined( __netcdf4_parallel ) 4834 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4447 !-- Inquire variable id 4448 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4449 ! 4450 !-- Check for collective read-operation and set respective NetCDF flags if required. 4451 IF ( collective_read ) THEN 4452 #if defined( __netcdf4_parallel ) 4453 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4835 4454 #endif 4836 ENDIF 4837 ! 4838 !-- Allocate temporary variable according to memory access on file. 4839 ALLOCATE( tmp(is:ie,js:je) ) 4840 ! 4841 !-- Get variable 4842 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 4843 start = (/ is+1, js+1 /), & 4844 count = (/ ie-is + 1, je-js+1 /) ) 4845 4846 CALL handle_error( 'get_variable_2d_int32', 531, variable_name ) 4847 ! 4848 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4849 DO i = is, ie 4850 DO j = js, je 4851 var(j-js+1,i-is+1) = tmp(i,j) 4852 ENDDO 4455 ENDIF 4456 ! 4457 !-- Allocate temporary variable according to memory access on file. 4458 ALLOCATE( tmp(is:ie,js:je) ) 4459 ! 4460 !-- Get variable 4461 nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ is+1, js+1 /), & 4462 count = (/ ie-is+1, je-js+1 /) ) 4463 4464 CALL handle_error( 'get_variable_2d_int32', 531, variable_name ) 4465 ! 4466 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4467 DO i = is, ie 4468 DO j = js, je 4469 var(j-js+1,i-is+1) = tmp(i,j) 4853 4470 ENDDO 4854 4855 DEALLOCATE( tmp ) 4856 4471 ENDDO 4472 4473 DEALLOCATE( tmp ) 4857 4474 #endif 4858 END SUBROUTINE get_variable_2d_int32 4859 4860 !------------------------------------------------------------------------------! 4475 4476 END SUBROUTINE get_variable_2d_int32 4477 4478 4479 !--------------------------------------------------------------------------------------------------! 4861 4480 ! Description: 4862 4481 ! ------------ 4863 !> Reads a 2D 8-bit INTEGER variable from file. Reading is done processor-wise, 4864 !> i.e. each core reads its own domain in slices along x. 4865 !------------------------------------------------------------------------------! 4866 SUBROUTINE get_variable_2d_int8( id, variable_name, var, is, ie, js, je ) 4867 4868 USE indices 4869 USE pegrid 4870 4871 IMPLICIT NONE 4872 4873 CHARACTER(LEN=*) :: variable_name !< variable name 4874 4875 INTEGER(iwp) :: i !< running index along x direction 4876 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 4877 INTEGER(iwp) :: is !< end index for subdomain input along x direction 4878 INTEGER(iwp), INTENT(IN) :: id !< file id 4879 INTEGER(iwp) :: id_var !< variable id 4880 INTEGER(iwp) :: j !< running index along y direction 4881 INTEGER(iwp) :: je !< start index for subdomain input along y direction 4882 INTEGER(iwp) :: js !< end index for subdomain input along y direction 4883 4884 INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4885 !< to its reverse memory access 4886 INTEGER(KIND=1), DIMENSION(:,:), INTENT(INOUT) :: var !< variable to be read 4482 !> Reads a 2D 8-bit INTEGER variable from file. Reading is done processor-wise, i.e. each core reads 4483 !> its own domain in slices along x. 4484 !--------------------------------------------------------------------------------------------------! 4485 SUBROUTINE get_variable_2d_int8( id, variable_name, var, is, ie, js, je ) 4486 4487 USE indices 4488 USE pegrid 4489 4490 IMPLICIT NONE 4491 4492 CHARACTER(LEN=*) :: variable_name !< variable name 4493 4494 INTEGER(iwp) :: i !< running index along x direction 4495 INTEGER(iwp), INTENT(IN) :: id !< file id 4496 INTEGER(iwp) :: id_var !< variable id 4497 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 4498 INTEGER(iwp) :: is !< end index for subdomain input along x direction 4499 INTEGER(iwp) :: j !< running index along y direction 4500 INTEGER(iwp) :: je !< start index for subdomain input along y direction 4501 INTEGER(iwp) :: js !< end index for subdomain input along y direction 4502 4503 INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4504 !< to its reverse memory access 4505 INTEGER(KIND=1), DIMENSION(:,:), INTENT(INOUT) :: var !< variable to be read 4506 4507 4887 4508 #if defined( __netcdf ) 4888 4509 ! 4889 !-- Inquire variable id 4890 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4891 ! 4892 !-- Check for collective read-operation and set respective NetCDF flags if 4893 !-- required. 4894 IF ( collective_read ) THEN 4895 #if defined( __netcdf4_parallel ) 4896 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4897 #endif 4898 ENDIF 4899 ! 4900 !-- Allocate temporary variable according to memory access on file. 4901 ALLOCATE( tmp(is:ie,js:je) ) 4902 ! 4903 !-- Get variable 4904 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 4905 start = (/ is+1, js+1 /), & 4906 count = (/ ie-is + 1, je-js+1 /) ) 4907 4908 CALL handle_error( 'get_variable_2d_int8', 532, variable_name ) 4909 ! 4910 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4911 DO i = is, ie 4912 DO j = js, je 4913 var(j-js+1,i-is+1) = tmp(i,j) 4914 ENDDO 4510 !-- Inquire variable id 4511 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4512 ! 4513 !-- Check for collective read-operation and set respective NetCDF flags if required. 4514 IF ( collective_read ) THEN 4515 #if defined( __netcdf4_parallel ) 4516 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4517 #endif 4518 ENDIF 4519 ! 4520 !-- Allocate temporary variable according to memory access on file. 4521 ALLOCATE( tmp(is:ie,js:je) ) 4522 ! 4523 !-- Get variable 4524 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 4525 start = (/ is+1, js+1 /), & 4526 count = (/ ie-is + 1, je-js+1 /) ) 4527 4528 CALL handle_error( 'get_variable_2d_int8', 532, variable_name ) 4529 ! 4530 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4531 DO i = is, ie 4532 DO j = js, je 4533 var(j-js+1,i-is+1) = tmp(i,j) 4915 4534 ENDDO 4916 4917 DEALLOCATE( tmp ) 4918 4535 ENDDO 4536 4537 DEALLOCATE( tmp ) 4919 4538 #endif 4920 END SUBROUTINE get_variable_2d_int8 4921 4922 4923 !------------------------------------------------------------------------------! 4539 4540 END SUBROUTINE get_variable_2d_int8 4541 4542 4543 !--------------------------------------------------------------------------------------------------! 4924 4544 ! Description: 4925 4545 ! ------------ 4926 4546 !> Reads a 3D 8-bit INTEGER variable from file. 4927 !------------------------------------------------------------------------------! 4928 SUBROUTINE get_variable_3d_int8( id, variable_name, var, is, ie, js, je, & 4929 ks, ke ) 4930 4931 USE indices 4932 USE pegrid 4933 4934 IMPLICIT NONE 4935 4936 CHARACTER(LEN=*) :: variable_name !< variable name 4937 4938 INTEGER(iwp) :: i !< index along x direction 4939 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 4940 INTEGER(iwp) :: is !< end index for subdomain input along x direction 4941 INTEGER(iwp), INTENT(IN) :: id !< file id 4942 INTEGER(iwp) :: id_var !< variable id 4943 INTEGER(iwp) :: j !< index along y direction 4944 INTEGER(iwp) :: je !< start index for subdomain input along y direction 4945 INTEGER(iwp) :: js !< end index for subdomain input along y direction 4946 INTEGER(iwp) :: k !< index along any 3rd dimension 4947 INTEGER(iwp) :: ke !< start index of 3rd dimension 4948 INTEGER(iwp) :: ks !< end index of 3rd dimension 4949 4950 INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4951 !< to its reverse memory access 4952 4953 INTEGER(KIND=1), DIMENSION(:,:,:), INTENT(INOUT) :: var !< variable to be read 4547 !--------------------------------------------------------------------------------------------------! 4548 SUBROUTINE get_variable_3d_int8( id, variable_name, var, is, ie, js, je, ks, ke ) 4549 4550 USE indices 4551 USE pegrid 4552 4553 IMPLICIT NONE 4554 4555 CHARACTER(LEN=*) :: variable_name !< variable name 4556 4557 INTEGER(iwp) :: i !< index along x direction 4558 INTEGER(iwp), INTENT(IN) :: id !< file id 4559 INTEGER(iwp) :: id_var !< variable id 4560 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 4561 INTEGER(iwp) :: is !< end index for subdomain input along x direction 4562 INTEGER(iwp) :: j !< index along y direction 4563 INTEGER(iwp) :: je !< start index for subdomain input along y direction 4564 INTEGER(iwp) :: js !< end index for subdomain input along y direction 4565 INTEGER(iwp) :: k !< index along any 3rd dimension 4566 INTEGER(iwp) :: ke !< start index of 3rd dimension 4567 INTEGER(iwp) :: ks !< end index of 3rd dimension 4568 4569 INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4570 !< to its reverse memory access 4571 4572 INTEGER(KIND=1), DIMENSION(:,:,:), INTENT(INOUT) :: var !< variable to be read 4954 4573 #if defined( __netcdf ) 4955 4574 4956 4575 ! 4957 !-- Inquire variable id 4958 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4959 ! 4960 !-- Check for collective read-operation and set respective NetCDF flags if 4961 !-- required. 4962 IF ( collective_read ) THEN 4576 !-- Inquire variable id 4577 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4578 ! 4579 !-- Check for collective read-operation and set respective NetCDF flags if required. 4580 IF ( collective_read ) THEN 4963 4581 #if defined( __netcdf4_parallel ) 4964 4582 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4965 4583 #endif 4966 ENDIF 4967 ! 4968 !-- Allocate temporary variable according to memory access on file. 4969 ALLOCATE( tmp(is:ie,js:je,ks:ke) ) 4970 ! 4971 !-- Get variable 4972 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 4973 start = (/ is+1, js+1, ks+1 /), & 4974 count = (/ ie-is+1, je-js+1, ke-ks+1 /) ) 4975 4976 CALL handle_error( 'get_variable_3d_int8', 533, variable_name ) 4977 ! 4978 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4979 DO i = is, ie 4980 DO j = js, je 4981 DO k = ks, ke 4982 var(k-ks+1,j-js+1,i-is+1) = tmp(i,j,k) 4584 ENDIF 4585 ! 4586 !-- Allocate temporary variable according to memory access on file. 4587 ALLOCATE( tmp(is:ie,js:je,ks:ke) ) 4588 ! 4589 !-- Get variable 4590 nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ is+1, js+1, ks+1 /), & 4591 count = (/ ie-is+1, je-js+1, ke-ks+1 /) ) 4592 4593 CALL handle_error( 'get_variable_3d_int8', 533, variable_name ) 4594 ! 4595 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4596 DO i = is, ie 4597 DO j = js, je 4598 DO k = ks, ke 4599 var(k-ks+1,j-js+1,i-is+1) = tmp(i,j,k) 4600 ENDDO 4601 ENDDO 4602 ENDDO 4603 4604 DEALLOCATE( tmp ) 4605 #endif 4606 4607 END SUBROUTINE get_variable_3d_int8 4608 4609 4610 !--------------------------------------------------------------------------------------------------! 4611 ! Description: 4612 ! ------------ 4613 !> Reads a 3D float variable from file. 4614 !--------------------------------------------------------------------------------------------------! 4615 SUBROUTINE get_variable_3d_real( id, variable_name, var, is, ie, js, je, ks, ke ) 4616 4617 USE indices 4618 USE pegrid 4619 4620 IMPLICIT NONE 4621 4622 CHARACTER(LEN=*) :: variable_name !< variable name 4623 4624 INTEGER(iwp) :: i !< index along x direction 4625 INTEGER(iwp), INTENT(IN) :: id !< file id 4626 INTEGER(iwp) :: id_var !< variable id 4627 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 4628 INTEGER(iwp) :: is !< end index for subdomain input along x direction 4629 INTEGER(iwp) :: j !< index along y direction 4630 INTEGER(iwp) :: je !< start index for subdomain input along y direction 4631 INTEGER(iwp) :: js !< end index for subdomain input along y direction 4632 INTEGER(iwp) :: k !< index along any 3rd dimension 4633 INTEGER(iwp) :: ke !< start index of 3rd dimension 4634 INTEGER(iwp) :: ks !< end index of 3rd dimension 4635 4636 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4637 !< to its reverse memory access 4638 4639 REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< variable to be read 4640 #if defined( __netcdf ) 4641 4642 ! 4643 !-- Inquire variable id 4644 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4645 ! 4646 !-- Check for collective read-operation and set respective NetCDF flags if required. 4647 IF ( collective_read ) THEN 4648 #if defined( __netcdf4_parallel ) 4649 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4650 #endif 4651 ENDIF 4652 ! 4653 !-- Allocate temporary variable according to memory access on file. 4654 ALLOCATE( tmp(is:ie,js:je,ks:ke) ) 4655 ! 4656 !-- Get variable 4657 nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ is+1, js+1, ks+1 /), & 4658 count = (/ ie-is+1, je-js+1, ke-ks+1 /) ) 4659 4660 CALL handle_error( 'get_variable_3d_real', 534, variable_name ) 4661 ! 4662 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4663 DO i = is, ie 4664 DO j = js, je 4665 DO k = ks, ke 4666 var(k-ks+1,j-js+1,i-is+1) = tmp(i,j,k) 4667 ENDDO 4668 ENDDO 4669 ENDDO 4670 4671 DEALLOCATE( tmp ) 4672 #endif 4673 4674 END SUBROUTINE get_variable_3d_real 4675 4676 4677 !--------------------------------------------------------------------------------------------------! 4678 ! Description: 4679 ! ------------ 4680 !> Reads a 4D float variable from file. 4681 !--------------------------------------------------------------------------------------------------! 4682 SUBROUTINE get_variable_4d_real( id, variable_name, var, is, ie, js, je, k1s, k1e, k2s, k2e ) 4683 4684 USE indices 4685 USE pegrid 4686 4687 IMPLICIT NONE 4688 4689 CHARACTER(LEN=*) :: variable_name !< variable name 4690 4691 INTEGER(iwp) :: i !< index along x direction 4692 INTEGER(iwp), INTENT(IN) :: id !< file id 4693 INTEGER(iwp) :: id_var !< variable id 4694 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 4695 INTEGER(iwp) :: is !< end index for subdomain input along x direction 4696 INTEGER(iwp) :: j !< index along y direction 4697 INTEGER(iwp) :: je !< start index for subdomain input along y direction 4698 INTEGER(iwp) :: js !< end index for subdomain input along y direction 4699 INTEGER(iwp) :: k1 !< index along 3rd direction 4700 INTEGER(iwp) :: k1e !< start index for 3rd dimension 4701 INTEGER(iwp) :: k1s !< end index for 3rd dimension 4702 INTEGER(iwp) :: k2 !< index along 4th direction 4703 INTEGER(iwp) :: k2e !< start index for 4th dimension 4704 INTEGER(iwp) :: k2s !< end index for 4th dimension 4705 4706 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4707 !< to its reverse memory access 4708 REAL(wp), DIMENSION(:,:,:,:), INTENT(INOUT) :: var !< variable to be read 4709 4710 4711 #if defined( __netcdf ) 4712 4713 ! 4714 !-- Inquire variable id 4715 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4716 ! 4717 !-- Check for collective read-operation and set respective NetCDF flags if required. 4718 IF ( collective_read ) THEN 4719 #if defined( __netcdf4_parallel ) 4720 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4721 #endif 4722 ENDIF 4723 4724 ! 4725 !-- Allocate temporary variable according to memory access on file. 4726 ALLOCATE( tmp(is:ie,js:je,k1s:k1e,k2s:k2e) ) 4727 ! 4728 !-- Get variable 4729 nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ is+1, js+1, k1s+1, k2s+1 /), & 4730 count = (/ ie-is+1, je-js+1, k1e-k1s+1, k2e-k2s+1 /) ) 4731 4732 CALL handle_error( 'get_variable_4d_real', 535, variable_name ) 4733 ! 4734 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4735 DO i = is, ie 4736 DO j = js, je 4737 DO k1 = k1s, k1e 4738 DO k2 = k2s, k2e 4739 var(k2-k2s+1,k1-k1s+1,j-js+1,i-is+1) = tmp(i,j,k1,k2) 4983 4740 ENDDO 4984 4741 ENDDO 4985 4742 ENDDO 4986 4987 DEALLOCATE( tmp ) 4988 4743 ENDDO 4744 4745 DEALLOCATE( tmp ) 4989 4746 #endif 4990 END SUBROUTINE get_variable_3d_int8 4991 4992 4993 !------------------------------------------------------------------------------! 4747 4748 END SUBROUTINE get_variable_4d_real 4749 4750 4751 !--------------------------------------------------------------------------------------------------! 4994 4752 ! Description: 4995 4753 ! ------------ 4996 !> Reads a 3D float variable from file. 4997 !------------------------------------------------------------------------------! 4998 SUBROUTINE get_variable_3d_real( id, variable_name, var, is, ie, js, je, & 4999 ks, ke ) 5000 5001 USE indices 5002 USE pegrid 5003 5004 IMPLICIT NONE 5005 5006 CHARACTER(LEN=*) :: variable_name !< variable name 5007 5008 INTEGER(iwp) :: i !< index along x direction 5009 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 5010 INTEGER(iwp) :: is !< end index for subdomain input along x direction 5011 INTEGER(iwp), INTENT(IN) :: id !< file id 5012 INTEGER(iwp) :: id_var !< variable id 5013 INTEGER(iwp) :: j !< index along y direction 5014 INTEGER(iwp) :: je !< start index for subdomain input along y direction 5015 INTEGER(iwp) :: js !< end index for subdomain input along y direction 5016 INTEGER(iwp) :: k !< index along any 3rd dimension 5017 INTEGER(iwp) :: ke !< start index of 3rd dimension 5018 INTEGER(iwp) :: ks !< end index of 3rd dimension 5019 5020 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 5021 !< to its reverse memory access 5022 5023 REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< variable to be read 4754 !> Reads a 4D float variable from file and store it to a 3-d variable. 4755 !--------------------------------------------------------------------------------------------------! 4756 SUBROUTINE get_variable_4d_to_3d_real( id, variable_name, var, ns, is, ie, js, je, ks, ke ) 4757 4758 USE indices 4759 USE pegrid 4760 4761 IMPLICIT NONE 4762 4763 CHARACTER(LEN=*) :: variable_name !< variable name 4764 4765 INTEGER(iwp) :: i !< index along x direction 4766 INTEGER(iwp), INTENT(IN) :: id !< file id 4767 INTEGER(iwp) :: id_var !< variable id 4768 INTEGER(iwp) :: ie !< end index for subdomain input along x direction 4769 INTEGER(iwp) :: is !< start index for subdomain input along x direction 4770 INTEGER(iwp) :: j !< index along y direction 4771 INTEGER(iwp) :: je !< end index for subdomain input along y direction 4772 INTEGER(iwp) :: js !< start index for subdomain input along y direction 4773 INTEGER(iwp) :: k !< index along any 4th dimension 4774 INTEGER(iwp) :: ke !< end index of 4th dimension 4775 INTEGER(iwp) :: ks !< start index of 4th dimension 4776 INTEGER(iwp) :: ns !< start index for subdomain input along n dimension 4777 4778 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4779 !< to its reverse memory access 4780 4781 REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< variable where the read data have to be stored: 4782 !< one dimension is reduced in the process 4783 4784 5024 4785 #if defined( __netcdf ) 5025 5026 ! 5027 !-- Inquire variable id 5028 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 5029 ! 5030 !-- Check for collective read-operation and set respective NetCDF flags if 5031 !-- required. 5032 IF ( collective_read ) THEN 4786 ! 4787 !-- Inquire variable id 4788 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4789 ! 4790 !-- Check for collective read-operation and set respective NetCDF flags if required. 4791 IF ( collective_read ) THEN 4792 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 4793 ENDIF 4794 ! 4795 !-- Allocate temporary variable according to memory access on file. 4796 ALLOCATE( tmp(is:ie,js:je,ks:ke) ) 4797 ! 4798 !-- Get variable 4799 nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ is+1, js+1, ks+1, ns+1 /), & 4800 count = (/ ie-is+1, je-js+1, ke-ks+1, 1 /) ) 4801 4802 CALL handle_error( 'get_variable_4d_to_3d_real', 536, variable_name ) 4803 ! 4804 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4805 DO i = is, ie 4806 DO j = js, je 4807 DO k = ks, ke 4808 var(k-ks+1,j-js+1,i-is+1) = tmp(i,j,k) 4809 ENDDO 4810 ENDDO 4811 ENDDO 4812 4813 DEALLOCATE( tmp ) 4814 #endif 4815 4816 END SUBROUTINE get_variable_4d_to_3d_real 4817 4818 4819 !--------------------------------------------------------------------------------------------------! 4820 ! Description: 4821 ! ------------ 4822 !> Reads a 3D float variables from dynamic driver with the last dimension only having 1 entry 4823 !> (time,z). Please note, the passed arguments are start indices and number of elements in each 4824 !> dimension, which is in contrast to the other 3d versions where start- and end indices are passed. 4825 !> The different handling compared to get_variable_2d_real is due to its different start-index 4826 !> treatment. 4827 !--------------------------------------------------------------------------------------------------! 4828 SUBROUTINE get_variable_2d_real_dynamic( id, variable_name, var, i1s, i2s, count_1, count_2 ) 4829 4830 USE indices 4831 USE pegrid 4832 4833 IMPLICIT NONE 4834 4835 CHARACTER(LEN=*) :: variable_name !< variable name 4836 4837 INTEGER(iwp) :: count_1 !< number of elements to be read along 1st dimension (with respect to file) 4838 INTEGER(iwp) :: count_2 !< number of elements to be read along 2nd dimension (with respect to file) 4839 INTEGER(iwp) :: i1 !< running index along 1st dimension on file 4840 INTEGER(iwp) :: i1s !< start index for subdomain input along 1st dimension (with respect to file) 4841 INTEGER(iwp) :: i2 !< running index along 2nd dimension on file 4842 INTEGER(iwp) :: i2s !< start index for subdomain input along 2nd dimension (with respect to file) 4843 INTEGER(iwp), INTENT(IN) :: id !< file id 4844 INTEGER(iwp) :: id_var !< variable id 4845 INTEGER(iwp) :: lb1 !< lower bound of 1st dimension (with respect to file) 4846 INTEGER(iwp) :: lb2 !< lower bound of 2nd dimension (with respect to file) 4847 INTEGER(iwp) :: ub1 !< upper bound of 1st dimension (with respect to file) 4848 INTEGER(iwp) :: ub2 !< upper bound of 2nd dimension (with respect to file) 4849 4850 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according to its reverse memory 4851 !< access 4852 4853 REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< input variable 4854 4855 4856 #if defined( __netcdf ) 4857 ! 4858 !-- Inquire variable id. 4859 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4860 ! 4861 !-- Allocate temporary variable according to memory access on file. 4862 !-- Therefore, determine dimension bounds of input array. 4863 lb1 = LBOUND( var,2 ) 4864 ub1 = UBOUND( var,2 ) 4865 lb2 = LBOUND( var,1 ) 4866 ub2 = UBOUND( var,1 ) 4867 4868 ALLOCATE( tmp(lb1:ub1,lb2:ub2) ) 4869 ! 4870 !-- Get variable 4871 nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ i1s, i2s /), & 4872 count = (/ count_1, count_2 /) ) 4873 4874 CALL handle_error( 'get_variable_2d_real_dynamic', 537, variable_name ) 4875 ! 4876 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4877 DO i2 = lb2, ub2 4878 DO i1 = lb1, ub1 4879 var(i2,i1,1) = tmp(i1,i2) 4880 ENDDO 4881 ENDDO 4882 4883 DEALLOCATE( tmp ) 4884 #endif 4885 4886 END SUBROUTINE get_variable_2d_real_dynamic 4887 4888 4889 !--------------------------------------------------------------------------------------------------! 4890 ! Description: 4891 ! ------------ 4892 !> Reads a 3D float variables from dynamic driver, such as time-dependent xy-, xz- or yz-boundary 4893 !> data as well as 3D initialization data. Please note, the passed arguments are start indices and 4894 !> number of elements in each dimension, which is in contrast to the other 3d versions where start- 4895 !> and end indices are passed. The different handling of 3D dynamic variables is due to its 4896 !> asymmetry for the u- and v component. 4897 !--------------------------------------------------------------------------------------------------! 4898 SUBROUTINE get_variable_3d_real_dynamic( id, variable_name, var, i1s, i2s, i3s, & 4899 count_1, count_2, count_3, par_access ) 4900 4901 USE indices 4902 USE pegrid 4903 4904 IMPLICIT NONE 4905 4906 CHARACTER(LEN=*) :: variable_name !< variable name 4907 4908 INTEGER(iwp) :: count_1 !< number of elements to be read along 1st dimension (with respect to file) 4909 INTEGER(iwp) :: count_2 !< number of elements to be read along 2nd dimension (with respect to file) 4910 INTEGER(iwp) :: count_3 !< number of elements to be read along 3rd dimension (with respect to file) 4911 INTEGER(iwp) :: i1 !< running index along 1st dimension on file 4912 INTEGER(iwp) :: i1s !< start index for subdomain input along 1st dimension (with respect to file) 4913 INTEGER(iwp) :: i2 !< running index along 2nd dimension on file 4914 INTEGER(iwp) :: i2s !< start index for subdomain input along 2nd dimension (with respect to file) 4915 INTEGER(iwp) :: i3 !< running index along 3rd dimension on file 4916 INTEGER(iwp) :: i3s !< start index of 3rd dimension, in dynamic file this is either time 4917 !<(2D boundary) or z (3D) 4918 INTEGER(iwp), INTENT(IN) :: id !< file id 4919 INTEGER(iwp) :: id_var !< variable id 4920 INTEGER(iwp) :: lb1 !< lower bound of 1st dimension (with respect to file) 4921 INTEGER(iwp) :: lb2 !< lower bound of 2nd dimension (with respect to file) 4922 INTEGER(iwp) :: lb3 !< lower bound of 3rd dimension (with respect to file) 4923 INTEGER(iwp) :: ub1 !< upper bound of 1st dimension (with respect to file) 4924 INTEGER(iwp) :: ub2 !< upper bound of 2nd dimension (with respect to file) 4925 INTEGER(iwp) :: ub3 !< upper bound of 3rd dimension (with respect to file) 4926 4927 LOGICAL :: par_access !< additional flag indicating whether parallel read operations should be 4928 !< performed or not 4929 4930 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 4931 !< to its reverse memory access 4932 4933 REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< input variable 4934 4935 4936 #if defined( __netcdf ) 4937 ! 4938 !-- Inquire variable id. 4939 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 4940 ! 4941 !-- Check for collective read-operation and set respective NetCDF flags if required. 4942 !-- Please note, in contrast to the other input routines where each PEs reads its subdomain data, 4943 !-- dynamic input data not by all PEs, only by those which encompass lateral model boundaries. 4944 !-- Hence, collective read operations are only enabled for top-boundary data. 4945 IF ( collective_read .AND. par_access ) THEN 5033 4946 #if defined( __netcdf4_parallel ) 5034 4947 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 5035 4948 #endif 5036 ENDIF 5037 ! 5038 !-- Allocate temporary variable according to memory access on file. 5039 ALLOCATE( tmp(is:ie,js:je,ks:ke) ) 5040 ! 5041 !-- Get variable 5042 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 5043 start = (/ is+1, js+1, ks+1 /), & 5044 count = (/ ie-is+1, je-js+1, ke-ks+1 /) ) 5045 5046 CALL handle_error( 'get_variable_3d_real', 534, variable_name ) 5047 ! 5048 !-- Resort data. Please note, dimension subscripts of var all start at 1. 5049 DO i = is, ie 4949 ENDIF 4950 ! 4951 !-- Allocate temporary variable according to memory access on file. 4952 !-- Therefore, determine dimension bounds of input array. 4953 lb1 = LBOUND( var,3 ) 4954 ub1 = UBOUND( var,3 ) 4955 lb2 = LBOUND( var,2 ) 4956 ub2 = UBOUND( var,2 ) 4957 lb3 = LBOUND( var,1 ) 4958 ub3 = UBOUND( var,1 ) 4959 ALLOCATE( tmp(lb1:ub1,lb2:ub2,lb3:ub3) ) 4960 ! 4961 !-- Get variable 4962 nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ i1s, i2s, i3s /), & 4963 count = (/ count_1, count_2, count_3 /) ) 4964 4965 CALL handle_error( 'get_variable_3d_real_dynamic', 537, variable_name ) 4966 ! 4967 !-- Resort data. Please note, dimension subscripts of var all start at 1. 4968 DO i3 = lb3, ub3 4969 DO i2 = lb2, ub2 4970 DO i1 = lb1, ub1 4971 var(i3,i2,i1) = tmp(i1,i2,i3) 4972 ENDDO 4973 ENDDO 4974 ENDDO 4975 4976 DEALLOCATE( tmp ) 4977 #endif 4978 4979 END SUBROUTINE get_variable_3d_real_dynamic 4980 4981 4982 !--------------------------------------------------------------------------------------------------! 4983 ! Description: 4984 ! ------------ 4985 !> Reads a 5D float variable from file and store it to a 4-d variable. 4986 !--------------------------------------------------------------------------------------------------! 4987 SUBROUTINE get_variable_5d_to_4d_real( id, variable_name, var, ns, ts, te, is, ie, js, je, ks, ke ) 4988 4989 USE indices 4990 USE pegrid 4991 4992 IMPLICIT NONE 4993 4994 CHARACTER(LEN=*) :: variable_name !< variable name 4995 4996 INTEGER(iwp) :: i !< index along x direction 4997 INTEGER(iwp), INTENT(IN) :: id !< file id 4998 INTEGER(iwp) :: id_var !< variable id 4999 INTEGER(iwp) :: ie !< end index for subdomain input along x direction 5000 INTEGER(iwp) :: is !< start index for subdomain input along x direction 5001 INTEGER(iwp) :: j !< index along y direction 5002 INTEGER(iwp) :: je !< end index for subdomain input along y direction 5003 INTEGER(iwp) :: js !< start index for subdomain input along y direction 5004 INTEGER(iwp) :: k !< index along any 5th dimension 5005 INTEGER(iwp) :: ke !< end index of 5th dimension 5006 INTEGER(iwp) :: ks !< start index of 5th dimension 5007 INTEGER(iwp) :: ns !< start index for subdomain input along n dimension: ns coincides here with 5008 !< ne, since, we select only one value along the 1st dimension n 5009 INTEGER(iwp) :: t !< index along t direction 5010 INTEGER(iwp) :: te !< end index for subdomain input along t direction 5011 INTEGER(iwp) :: ts !< start index for subdomain input along t direction 5012 5013 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according to its reverse 5014 !< memory access 5015 REAL(wp), DIMENSION(:,:,:,:), INTENT(INOUT) :: var !< variable to be read 5016 #if defined( __netcdf ) 5017 ! 5018 !-- Inquire variable id 5019 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 5020 ! 5021 !-- Check for collective read-operation and set respective NetCDF flags if required. 5022 IF ( collective_read ) THEN 5023 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 5024 ENDIF 5025 ! 5026 !-- Allocate temporary variable according to memory access on file. 5027 ALLOCATE( tmp(ks:ke,js:je,is:is,ts:te) ) 5028 ! 5029 !-- Get variable 5030 nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ ks+1, js+1, is+1, ts+1, ns /), & 5031 count = (/ ke-ks+1, je-js+1, ie-is+1, te-ts+1, 1 /) ) 5032 5033 CALL handle_error( 'get_variable_5d_to_4d_real', 538, variable_name ) 5034 ! 5035 !-- Resort data. Please note, dimension subscripts of var all start at 1. 5036 DO t = ts, te 5037 DO i = is, ie 5050 5038 DO j = js, je 5051 5039 DO k = ks, ke 5052 var( k-ks+1,j-js+1,i-is+1) = tmp(i,j,k)5040 var(t-ts+1,i-is+1,j-js+1,k-ks+1) = tmp(k,j,i,t) 5053 5041 ENDDO 5054 5042 ENDDO 5055 5043 ENDDO 5056 5057 DEALLOCATE( tmp ) 5058 5044 ENDDO 5045 5046 DEALLOCATE( tmp ) 5059 5047 #endif 5060 END SUBROUTINE get_variable_3d_real 5061 5062 !------------------------------------------------------------------------------! 5048 5049 END SUBROUTINE get_variable_5d_to_4d_real 5050 5051 5052 !--------------------------------------------------------------------------------------------------! 5063 5053 ! Description: 5064 5054 ! ------------ 5065 !> Reads a 4D float variable from file. 5066 !------------------------------------------------------------------------------! 5067 SUBROUTINE get_variable_4d_real( id, variable_name, var, is, ie, js, je, & 5068 k1s, k1e, k2s, k2e ) 5069 5070 USE indices 5071 USE pegrid 5072 5073 IMPLICIT NONE 5074 5075 CHARACTER(LEN=*) :: variable_name !< variable name 5076 5077 INTEGER(iwp) :: i !< index along x direction 5078 INTEGER(iwp) :: ie !< start index for subdomain input along x direction 5079 INTEGER(iwp) :: is !< end index for subdomain input along x direction 5080 INTEGER(iwp), INTENT(IN) :: id !< file id 5081 INTEGER(iwp) :: id_var !< variable id 5082 INTEGER(iwp) :: j !< index along y direction 5083 INTEGER(iwp) :: je !< start index for subdomain input along y direction 5084 INTEGER(iwp) :: js !< end index for subdomain input along y direction 5085 INTEGER(iwp) :: k1 !< index along 3rd direction 5086 INTEGER(iwp) :: k1e !< start index for 3rd dimension 5087 INTEGER(iwp) :: k1s !< end index for 3rd dimension 5088 INTEGER(iwp) :: k2 !< index along 4th direction 5089 INTEGER(iwp) :: k2e !< start index for 4th dimension 5090 INTEGER(iwp) :: k2s !< end index for 4th dimension 5091 5092 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 5093 !< to its reverse memory access 5094 REAL(wp), DIMENSION(:,:,:,:), INTENT(INOUT) :: var !< variable to be read 5055 !> Reads a 5D float variable from file. 5056 !> Note - This subroutine is used specific for reading NC variable emission_values having a "z" 5057 !> dimension. Mentioned dimension is to be removed in the future and this subroutine shall 5058 !> be depreciated accordingly. (ecc 20190418) 5059 !--------------------------------------------------------------------------------------------------! 5060 SUBROUTINE get_variable_5d_real( id, variable_name, var, is, ie, js, je, k1s, k1e, k2s, k2e, k3s, & 5061 k3e ) 5062 5063 USE indices 5064 USE pegrid 5065 5066 IMPLICIT NONE 5067 5068 CHARACTER(LEN=*) :: variable_name !< variable name 5069 5070 INTEGER(iwp) :: i !< i index 5071 INTEGER(iwp), INTENT(IN) :: id !< netCDF file ID (ncid) 5072 INTEGER(iwp) :: id_var !< netCDF variable ID (varid) 5073 INTEGER(iwp) :: ie !< i index start 5074 INTEGER(iwp) :: is !< i index end 5075 INTEGER(iwp) :: j !< j index 5076 INTEGER(iwp) :: je !< j index start 5077 INTEGER(iwp) :: js !< j index end 5078 INTEGER(iwp) :: k1 !< k1 index 5079 INTEGER(iwp) :: k1e !< k1 index start 5080 INTEGER(iwp) :: k1s !< k1 index end 5081 INTEGER(iwp) :: k2 !< k2 index 5082 INTEGER(iwp) :: k2e !< k2 index start 5083 INTEGER(iwp) :: k2s !< k2 index end 5084 INTEGER(iwp) :: k3 !< k3 index 5085 INTEGER(iwp) :: k3e !< k3 index start 5086 INTEGER(iwp) :: k3s !< k3 index end 5087 5088 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: tmp !< temp array to read data from file 5089 REAL(wp), DIMENSION(:,:,:,:,:), INTENT(INOUT) :: var !< variable to be read 5090 5095 5091 #if defined( __netcdf ) 5096 5092 5097 5093 ! 5098 !-- Inquire variable id 5099 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 5100 ! 5101 !-- Check for collective read-operation and set respective NetCDF flags if 5102 !-- required. 5103 IF ( collective_read ) THEN 5104 #if defined( __netcdf4_parallel ) 5105 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 5094 !-- Inquire variable id 5095 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 5096 5097 ! 5098 !-- Check for collective read-operation and set respective NetCDF flags if required. 5099 IF ( collective_read ) THEN 5100 5101 #if defined( __netcdf4_parallel ) 5102 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 5106 5103 #endif 5107 ENDIF 5108 5109 ! 5110 !-- Allocate temporary variable according to memory access on file. 5111 ALLOCATE( tmp(is:ie,js:je,k1s:k1e,k2s:k2e) ) 5112 ! 5113 !-- Get variable 5114 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 5115 start = (/ is+1, js+1, k1s+1, k2s+1 /), & 5116 count = (/ ie-is+1, je-js+1, k1e-k1s+1, k2e-k2s+1 /) ) 5117 5118 CALL handle_error( 'get_variable_4d_real', 535, variable_name ) 5119 ! 5120 !-- Resort data. Please note, dimension subscripts of var all start at 1. 5121 DO i = is, ie 5122 DO j = js, je 5123 DO k1 = k1s, k1e 5124 DO k2 = k2s, k2e 5125 var(k2-k2s+1,k1-k1s+1,j-js+1,i-is+1) = tmp(i,j,k1,k2) 5104 5105 ENDIF 5106 5107 ! 5108 !-- Allocate temporary variable according to memory access on file. 5109 ALLOCATE( tmp(is:ie,js:je,k1s:k1e,k2s:k2e,k3s:k3e) ) 5110 5111 ! 5112 !-- Get variable from file 5113 nc_stat = NF90_GET_VAR ( id, id_var, tmp, start = (/ is+1, js+1, k1s+1, k2s+1, k3s+1 /), & 5114 count = (/ ie-is+1, je-js+1, k1e-k1s+1, k2e-k2s+1, k3e-k3s+1 /) ) 5115 5116 CALL handle_error( 'get_variable_5d_real', 535, variable_name ) 5117 5118 ! 5119 !-- Resort (reverse index order) and standardize (from 1 to N) output array 5120 DO i = is, ie 5121 DO j = js, je 5122 DO k1 = k1s, k1e 5123 DO k2 = k2s, k2e 5124 DO k3 = k3s, k3e 5125 var(k3-k3s+1,k2-k2s+1,k1-k1s+1,j-js+1,i-is+1) = tmp(i,j,k1,k2,k3) 5126 5126 ENDDO 5127 5127 ENDDO 5128 5128 ENDDO 5129 5129 ENDDO 5130 5131 DEALLOCATE( tmp ) 5132 5130 ENDDO 5131 5132 DEALLOCATE( tmp ) 5133 5133 #endif 5134 5134 5135 END SUBROUTINE get_variable_4d_real 5136 5137 !------------------------------------------------------------------------------! 5135 END SUBROUTINE get_variable_5d_real 5136 5137 5138 !--------------------------------------------------------------------------------------------------! 5138 5139 ! Description: 5139 5140 ! ------------ 5140 !> Reads a 4D float variable from file and store it to a 3-d variable. 5141 !------------------------------------------------------------------------------! 5142 SUBROUTINE get_variable_4d_to_3d_real( id, variable_name, var, ns, is, ie, js, je, & 5143 ks, ke ) 5144 5145 USE indices 5146 USE pegrid 5147 5148 IMPLICIT NONE 5149 5150 CHARACTER(LEN=*) :: variable_name !< variable name 5151 5152 INTEGER(iwp) :: i !< index along x direction 5153 INTEGER(iwp) :: ie !< end index for subdomain input along x direction 5154 INTEGER(iwp) :: is !< start index for subdomain input along x direction 5155 INTEGER(iwp), INTENT(IN) :: id !< file id 5156 INTEGER(iwp) :: id_var !< variable id 5157 INTEGER(iwp) :: j !< index along y direction 5158 INTEGER(iwp) :: je !< end index for subdomain input along y direction 5159 INTEGER(iwp) :: js !< start index for subdomain input along y direction 5160 INTEGER(iwp) :: k !< index along any 4th dimension 5161 INTEGER(iwp) :: ke !< end index of 4th dimension 5162 INTEGER(iwp) :: ks !< start index of 4th dimension 5163 INTEGER(iwp) :: ns !< start index for subdomain input along n dimension 5164 5165 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 5166 !< to its reverse memory access 5167 5168 REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< variable where the read data have to be stored: 5169 !< one dimension is reduced in the process 5141 !> Reads a 5D float variables from dynamic driver, such as time-dependent xy-, xz- or yz-boundary 5142 !> data as well as 5D initialization data. Please note, the passed arguments are start indices and 5143 !> number of elements in each dimension, which is in contrast to the other 3d versions where start- 5144 !> and end indices are passed. The different handling of 5D dynamic variables is due to its 5145 !> asymmetry for the u- and v component. 5146 !> Note(1) - This subroutine is more flexible than get_variable_xd_real as it provides much better 5147 !> control over starting and count indices. 5148 !> (ecc 20190418) 5149 !> Note(2) - This subroutine is used specific for reading NC variable emission_values having a "z" 5150 !> dimension. Mentioned dimension is to be removed in the future and this subroutine shall 5151 !> be depreciated accordingly (ecc 20190418) 5152 !--------------------------------------------------------------------------------------------------! 5153 SUBROUTINE get_variable_5d_real_dynamic( id, variable_name, var, i1s, i2s, i3s, i4s, i5s, & 5154 count_1, count_2, count_3, count_4, count_5, par_access ) 5155 5156 USE indices 5157 USE pegrid 5158 5159 IMPLICIT NONE 5160 5161 CHARACTER(LEN=*) :: variable_name !< variable name 5162 5163 INTEGER(iwp) :: count_1 !< # elements read in dimension 1 wrt file 5164 INTEGER(iwp) :: count_2 !< # elements read in dimension 2 wrt file 5165 INTEGER(iwp) :: count_3 !< # elements read in dimension 3 wrt file 5166 INTEGER(iwp) :: count_4 !< # elements read in dimension 4 wrt file 5167 INTEGER(iwp) :: count_5 !< # elements read in dimension 5 wrt file 5168 INTEGER(iwp) :: i1 !< index for dimension 1 on file 5169 INTEGER(iwp) :: i1s !< starting index for dimension 1 hyperslab 5170 INTEGER(iwp) :: i2 !< index for dimension 2 on file 5171 INTEGER(iwp) :: i2s !< starting index for dimension 2 hyperslab 5172 INTEGER(iwp) :: i3 !< index for dimension 3 on file 5173 INTEGER(iwp) :: i3s !< starting index for dimension 3 hyperslab 5174 INTEGER(iwp) :: i4 !< index for dimension 4 on file 5175 INTEGER(iwp) :: i4s !< starting index for dimension 4 hyperslab 5176 INTEGER(iwp) :: i5 !< index for dimension 5 on file 5177 INTEGER(iwp) :: i5s !< starting index for dimension 5 hyperslab 5178 INTEGER(iwp), INTENT(IN) :: id !< netCDF file id (ncid) 5179 INTEGER(iwp) :: id_var !< netCDF variable id (varid) 5180 INTEGER(iwp) :: lb1 !< lower bound of dimension 1 wrt file 5181 INTEGER(iwp) :: lb2 !< lower bound of dimension 2 wrt file 5182 INTEGER(iwp) :: lb3 !< lower bound of dimension 3 wrt file 5183 INTEGER(iwp) :: lb4 !< lower bound of dimension 4 wrt file 5184 INTEGER(iwp) :: lb5 !< lower bound of dimension 5 wrt file 5185 INTEGER(iwp) :: ub1 !< upper bound of dimension 1 wrt file 5186 INTEGER(iwp) :: ub2 !< upper bound of dimension 2 wrt file 5187 INTEGER(iwp) :: ub3 !< upper bound of dimension 3 wrt file 5188 INTEGER(iwp) :: ub4 !< upper bound of dimension 4 wrt file 5189 INTEGER(iwp) :: ub5 !< upper bound of dimension 5 wrt file 5190 5191 LOGICAL :: par_access !< additional flag indicating parallel read 5192 5193 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according to its reverse 5194 !< array index order 5195 REAL(wp), DIMENSION(:,:,:,:,:), INTENT(INOUT) :: var !< input variable 5196 5197 5170 5198 #if defined( __netcdf ) 5171 5172 ! 5173 !-- Inquire variable id 5174 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 5175 ! 5176 !-- Check for collective read-operation and set respective NetCDF flags if 5177 !-- required. 5178 IF ( collective_read ) THEN 5179 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 5180 ENDIF 5181 ! 5182 !-- Allocate temporary variable according to memory access on file. 5183 ALLOCATE( tmp(is:ie,js:je,ks:ke) ) 5184 ! 5185 !-- Get variable 5186 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 5187 start = (/ is+1, js+1, ks+1, ns+1 /), & 5188 count = (/ ie-is+1, je-js+1, ke-ks+1, 1 /) ) 5189 5190 CALL handle_error( 'get_variable_4d_to_3d_real', 536, variable_name ) 5191 ! 5192 !-- Resort data. Please note, dimension subscripts of var all start at 1. 5193 DO i = is, ie 5194 DO j = js, je 5195 DO k = ks, ke 5196 var(k-ks+1,j-js+1,i-is+1) = tmp(i,j,k) 5197 ENDDO 5198 ENDDO 5199 ENDDO 5200 5201 DEALLOCATE( tmp ) 5202 5199 ! 5200 !-- Inquire variable id. 5201 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 5202 5203 ! 5204 !-- Check for collective read-operation and set respective NetCDF flags if required. 5205 !-- Please note, in contrast to the other input routines where each PEs reads its subdomain data, 5206 !-- dynamic input data not by all PEs, only by those which encompass lateral model boundaries. 5207 !-- Hence, collective read operations are only enabled for top-boundary data. 5208 IF ( collective_read .AND. par_access ) THEN 5209 5210 #if defined( __netcdf4_parallel ) 5211 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 5203 5212 #endif 5204 END SUBROUTINE get_variable_4d_to_3d_real 5205 5206 !------------------------------------------------------------------------------! 5207 ! Description: 5208 ! ------------ 5209 !> Reads a 3D float variables from dynamic driver with the last dimension only 5210 !> having 1 entry (time,z). Please note, 5211 !> the passed arguments are start indices and number of elements in each 5212 !> dimension, which is in contrast to the other 3d versions where start- and 5213 !> end indices are passed. The different handling compared to get_variable_2d_real 5214 !> is due to its different start-index treatment. 5215 !------------------------------------------------------------------------------! 5216 SUBROUTINE get_variable_2d_real_dynamic( id, variable_name, var, & 5217 i1s, i2s, & 5218 count_1, count_2 ) 5219 5220 USE indices 5221 USE pegrid 5222 5223 IMPLICIT NONE 5224 5225 CHARACTER(LEN=*) :: variable_name !< variable name 5226 5227 INTEGER(iwp) :: count_1 !< number of elements to be read along 1st dimension (with respect to file) 5228 INTEGER(iwp) :: count_2 !< number of elements to be read along 2nd dimension (with respect to file) 5229 INTEGER(iwp) :: i1 !< running index along 1st dimension on file 5230 INTEGER(iwp) :: i1s !< start index for subdomain input along 1st dimension (with respect to file) 5231 INTEGER(iwp) :: i2 !< running index along 2nd dimension on file 5232 INTEGER(iwp) :: i2s !< start index for subdomain input along 2nd dimension (with respect to file) 5233 INTEGER(iwp), INTENT(IN) :: id !< file id 5234 INTEGER(iwp) :: id_var !< variable id 5235 INTEGER(iwp) :: lb1 !< lower bound of 1st dimension (with respect to file) 5236 INTEGER(iwp) :: lb2 !< lower bound of 2nd dimension (with respect to file) 5237 INTEGER(iwp) :: ub1 !< upper bound of 1st dimension (with respect to file) 5238 INTEGER(iwp) :: ub2 !< upper bound of 2nd dimension (with respect to file) 5239 5240 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according to its reverse memory access 5241 5242 REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< input variable 5243 5244 #if defined( __netcdf ) 5245 ! 5246 !-- Inquire variable id. 5247 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 5248 ! 5249 !-- Allocate temporary variable according to memory access on file. 5250 !-- Therefore, determine dimension bounds of input array. 5251 lb1 = LBOUND(var,2) 5252 ub1 = UBOUND(var,2) 5253 lb2 = LBOUND(var,1) 5254 ub2 = UBOUND(var,1) 5255 5256 ALLOCATE( tmp(lb1:ub1,lb2:ub2) ) 5257 ! 5258 !-- Get variable 5259 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 5260 start = (/ i1s, i2s /), & 5261 count = (/ count_1, count_2 /) ) 5262 5263 CALL handle_error( 'get_variable_2d_real_dynamic', 537, variable_name ) 5264 ! 5265 !-- Resort data. Please note, dimension subscripts of var all start at 1. 5266 DO i2 = lb2, ub2 5267 DO i1 = lb1, ub1 5268 var(i2,i1,1) = tmp(i1,i2) 5269 ENDDO 5270 ENDDO 5271 5272 DEALLOCATE( tmp ) 5273 #endif 5274 END SUBROUTINE get_variable_2d_real_dynamic 5275 5276 !------------------------------------------------------------------------------! 5277 ! Description: 5278 ! ------------ 5279 !> Reads a 3D float variables from dynamic driver, such as time-dependent xy-, 5280 !> xz- or yz-boundary data as well as 3D initialization data. Please note, 5281 !> the passed arguments are start indices and number of elements in each 5282 !> dimension, which is in contrast to the other 3d versions where start- and 5283 !> end indices are passed. The different handling of 3D dynamic variables is 5284 !> due to its asymmetry for the u- and v component. 5285 !------------------------------------------------------------------------------! 5286 SUBROUTINE get_variable_3d_real_dynamic( id, variable_name, var, & 5287 i1s, i2s, i3s, & 5288 count_1, count_2, count_3, & 5289 par_access ) 5290 5291 USE indices 5292 USE pegrid 5293 5294 IMPLICIT NONE 5295 5296 CHARACTER(LEN=*) :: variable_name !< variable name 5297 5298 LOGICAL :: par_access !< additional flag indicating whether parallel read operations should be performed or not 5299 5300 INTEGER(iwp) :: count_1 !< number of elements to be read along 1st dimension (with respect to file) 5301 INTEGER(iwp) :: count_2 !< number of elements to be read along 2nd dimension (with respect to file) 5302 INTEGER(iwp) :: count_3 !< number of elements to be read along 3rd dimension (with respect to file) 5303 INTEGER(iwp) :: i1 !< running index along 1st dimension on file 5304 INTEGER(iwp) :: i1s !< start index for subdomain input along 1st dimension (with respect to file) 5305 INTEGER(iwp) :: i2 !< running index along 2nd dimension on file 5306 INTEGER(iwp) :: i2s !< start index for subdomain input along 2nd dimension (with respect to file) 5307 INTEGER(iwp) :: i3 !< running index along 3rd dimension on file 5308 INTEGER(iwp) :: i3s !< start index of 3rd dimension, in dynamic file this is either time (2D boundary) or z (3D) 5309 INTEGER(iwp), INTENT(IN) :: id !< file id 5310 INTEGER(iwp) :: id_var !< variable id 5311 INTEGER(iwp) :: lb1 !< lower bound of 1st dimension (with respect to file) 5312 INTEGER(iwp) :: lb2 !< lower bound of 2nd dimension (with respect to file) 5313 INTEGER(iwp) :: lb3 !< lower bound of 3rd dimension (with respect to file) 5314 INTEGER(iwp) :: ub1 !< upper bound of 1st dimension (with respect to file) 5315 INTEGER(iwp) :: ub2 !< upper bound of 2nd dimension (with respect to file) 5316 INTEGER(iwp) :: ub3 !< upper bound of 3rd dimension (with respect to file) 5317 5318 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 5319 !< to its reverse memory access 5320 5321 REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) :: var !< input variable 5322 5323 #if defined( __netcdf ) 5324 ! 5325 !-- Inquire variable id. 5326 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 5327 ! 5328 !-- Check for collective read-operation and set respective NetCDF flags if 5329 !-- required. 5330 !-- Please note, in contrast to the other input routines where each PEs 5331 !-- reads its subdomain data, dynamic input data not by all PEs, only 5332 !-- by those which encompass lateral model boundaries. Hence, collective 5333 !-- read operations are only enabled for top-boundary data. 5334 IF ( collective_read .AND. par_access ) THEN 5335 #if defined( __netcdf4_parallel ) 5336 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 5337 #endif 5338 ENDIF 5339 ! 5340 !-- Allocate temporary variable according to memory access on file. 5341 !-- Therefore, determine dimension bounds of input array. 5342 lb1 = LBOUND(var,3) 5343 ub1 = UBOUND(var,3) 5344 lb2 = LBOUND(var,2) 5345 ub2 = UBOUND(var,2) 5346 lb3 = LBOUND(var,1) 5347 ub3 = UBOUND(var,1) 5348 ALLOCATE( tmp(lb1:ub1,lb2:ub2,lb3:ub3) ) 5349 ! 5350 !-- Get variable 5351 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 5352 start = (/ i1s, i2s, i3s /), & 5353 count = (/ count_1, count_2, count_3 /) ) 5354 5355 CALL handle_error( 'get_variable_3d_real_dynamic', 537, variable_name ) 5356 ! 5357 !-- Resort data. Please note, dimension subscripts of var all start at 1. 5358 DO i3 = lb3, ub3 5359 DO i2 = lb2, ub2 5360 DO i1 = lb1, ub1 5361 var(i3,i2,i1) = tmp(i1,i2,i3) 5362 ENDDO 5363 ENDDO 5364 ENDDO 5365 5366 DEALLOCATE( tmp ) 5367 #endif 5368 END SUBROUTINE get_variable_3d_real_dynamic 5369 5370 !------------------------------------------------------------------------------! 5371 ! Description: 5372 ! ------------ 5373 !> Reads a 5D float variable from file and store it to a 4-d variable. 5374 !------------------------------------------------------------------------------! 5375 SUBROUTINE get_variable_5d_to_4d_real( id, variable_name, var, & 5376 ns, ts, te, is, ie, js, je, ks, ke ) 5377 5378 USE indices 5379 USE pegrid 5380 5381 IMPLICIT NONE 5382 5383 CHARACTER(LEN=*) :: variable_name !< variable name 5384 5385 INTEGER(iwp) :: ns !< start index for subdomain input along n dimension: 5386 !< ns coincides here with ne, since, we select only one 5387 !< value along the 1st dimension n 5388 5389 INTEGER(iwp) :: t !< index along t direction 5390 INTEGER(iwp) :: te !< end index for subdomain input along t direction 5391 INTEGER(iwp) :: ts !< start index for subdomain input along t direction 5392 5393 INTEGER(iwp) :: i !< index along x direction 5394 INTEGER(iwp) :: ie !< end index for subdomain input along x direction 5395 INTEGER(iwp) :: is !< start index for subdomain input along x direction 5396 INTEGER(iwp), INTENT(IN) :: id !< file id 5397 INTEGER(iwp) :: id_var !< variable id 5398 INTEGER(iwp) :: j !< index along y direction 5399 INTEGER(iwp) :: je !< end index for subdomain input along y direction 5400 INTEGER(iwp) :: js !< start index for subdomain input along y direction 5401 INTEGER(iwp) :: k !< index along any 5th dimension 5402 INTEGER(iwp) :: ke !< end index of 5th dimension 5403 INTEGER(iwp) :: ks !< start index of 5th dimension 5404 5405 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data from file according 5406 ! to its reverse memory access 5407 REAL(wp), DIMENSION(:,:,:,:), INTENT(INOUT) :: var !< variable to be read 5408 #if defined( __netcdf ) 5409 ! 5410 !-- Inquire variable id 5411 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 5412 ! 5413 !-- Check for collective read-operation and set respective NetCDF flags if 5414 !-- required. 5415 IF ( collective_read ) THEN 5416 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 5417 ENDIF 5418 ! 5419 !-- Allocate temporary variable according to memory access on file. 5420 ALLOCATE( tmp(ks:ke,js:je,is:is,ts:te) ) 5421 ! 5422 !-- Get variable 5423 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 5424 start = (/ ks+1, js+1, is+1, ts+1, ns /), & 5425 count = (/ ke-ks+1, je-js+1, ie-is+1, te-ts+1, 1 /) ) 5426 5427 CALL handle_error( 'get_variable_5d_to_4d_real', 538, variable_name ) 5428 ! 5429 !-- Resort data. Please note, dimension subscripts of var all start at 1. 5430 5431 DO t = ts, te 5432 DO i = is, ie 5433 DO j = js, je 5434 DO k = ks, ke 5435 var(t-ts+1,i-is+1,j-js+1,k-ks+1) = tmp(k,j,i,t) 5436 ENDDO 5437 ENDDO 5438 ENDDO 5439 ENDDO 5440 5441 DEALLOCATE( tmp ) 5442 #endif 5443 END SUBROUTINE get_variable_5d_to_4d_real 5444 5445 5446 !------------------------------------------------------------------------------! 5447 ! Description: 5448 ! ------------ 5449 !> Reads a 5D float variable from file. 5450 !> NOTE - This subroutine is used specific for reading NC variable 5451 !> emission_values having a "z" dimension. Said dimension 5452 !> is to be removed in the future and this subroutine shall 5453 !> be depreciated accordingly (ecc 20190418) 5454 !------------------------------------------------------------------------------! 5455 SUBROUTINE get_variable_5d_real( id, variable_name, var, is, ie, js, je, & 5456 k1s, k1e, k2s, k2e, k3s, k3e ) 5457 5458 USE indices 5459 USE pegrid 5460 5461 IMPLICIT NONE 5462 5463 CHARACTER(LEN=*) :: variable_name !< variable name 5464 5465 INTEGER(iwp) :: i !< i index 5466 INTEGER(iwp) :: ie !< i index start 5467 INTEGER(iwp) :: is !< i index end 5468 INTEGER(iwp) :: id_var !< netCDF variable ID (varid) 5469 INTEGER(iwp) :: j !< j index 5470 INTEGER(iwp) :: je !< j index start 5471 INTEGER(iwp) :: js !< j index end 5472 INTEGER(iwp) :: k1 !< k1 index 5473 INTEGER(iwp) :: k1e !< k1 index start 5474 INTEGER(iwp) :: k1s !< k1 index end 5475 INTEGER(iwp) :: k2 !< k2 index 5476 INTEGER(iwp) :: k2e !< k2 index start 5477 INTEGER(iwp) :: k2s !< k2 index end 5478 INTEGER(iwp) :: k3 !< k3 index 5479 INTEGER(iwp) :: k3e !< k3 index start 5480 INTEGER(iwp) :: k3s !< k3 index end 5481 INTEGER(iwp), INTENT(IN) :: id !< netCDF file ID (ncid) 5482 5483 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: tmp !< temp array to read data from file 5484 REAL(wp), DIMENSION(:,:,:,:,:), INTENT(INOUT) :: var !< variable to be read 5485 5486 #if defined( __netcdf ) 5487 5488 ! 5489 !-- Inquire variable id 5490 5491 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 5492 5493 ! 5494 !-- Check for collective read-operation and set respective NetCDF flags if required. 5495 5496 IF ( collective_read ) THEN 5497 5498 #if defined( __netcdf4_parallel ) 5499 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 5500 #endif 5501 5502 ENDIF 5503 5504 ! 5505 !-- Allocate temporary variable according to memory access on file. 5506 5507 ALLOCATE( tmp(is:ie,js:je,k1s:k1e,k2s:k2e,k3s:k3e) ) 5508 5509 ! 5510 !-- Get variable from file 5511 5512 nc_stat = NF90_GET_VAR ( id, id_var, tmp, & 5513 start = (/ is+1, js+1, k1s+1, k2s+1, k3s+1 /), & 5514 count = (/ ie-is+1, je-js+1, k1e-k1s+1, k2e-k2s+1, k3e-k3s+1 /) ) 5515 5516 CALL handle_error( 'get_variable_5d_real', 535, variable_name ) 5517 5518 ! 5519 !-- Resort (reverse index order) and standardize (from 1 to N) output array 5520 5521 DO i = is, ie 5522 DO j = js, je 5523 DO k1 = k1s, k1e 5524 DO k2 = k2s, k2e 5525 DO k3 = k3s, k3e 5526 var(k3-k3s+1,k2-k2s+1,k1-k1s+1,j-js+1,i-is+1) = tmp(i,j,k1,k2,k3) 5527 ENDDO 5213 5214 ENDIF 5215 5216 ! 5217 !-- Allocate temporary variable according to memory access on file. 5218 !-- Therefore, determine dimension bounds of input array. 5219 lb1 = LBOUND( var,5 ) 5220 ub1 = UBOUND( var,5 ) 5221 lb2 = LBOUND( var,4 ) 5222 ub2 = UBOUND( var,4 ) 5223 lb3 = LBOUND( var,3 ) 5224 ub3 = UBOUND( var,3 ) 5225 lb4 = LBOUND( var,2 ) 5226 ub4 = UBOUND( var,2 ) 5227 lb5 = LBOUND( var,1 ) 5228 ub5 = UBOUND( var,1 ) 5229 ALLOCATE( tmp(lb1:ub1,lb2:ub2,lb3:ub3,lb4:ub4,lb5:ub5) ) 5230 5231 ! 5232 !-- Get variable 5233 nc_stat = NF90_GET_VAR( id, id_var, tmp, start = (/ i1s, i2s, i3s, i4s, i5s /), & 5234 count = (/ count_1, count_2, count_3, count_4, count_5 /) ) 5235 5236 CALL handle_error( 'get_variable_3d_real_dynamic', 537, variable_name ) 5237 5238 ! 5239 !-- Assign temp array to output. Note reverse index order 5240 DO i5 = lb5, ub5 5241 DO i4 = lb4, ub4 5242 DO i3 = lb3, ub3 5243 DO i2 = lb2, ub2 5244 DO i1 = lb1, ub1 5245 var(i5,i4,i3,i2,i1) = tmp(i1,i2,i3,i4,i5) 5528 5246 ENDDO 5529 5247 ENDDO 5530 5248 ENDDO 5531 5249 ENDDO 5532 5533 DEALLOCATE( tmp ) 5534 5250 ENDDO 5251 5252 DEALLOCATE( tmp ) 5535 5253 #endif 5536 5254 5537 END SUBROUTINE get_variable_5d_real 5538 5539 5540 !------------------------------------------------------------------------------! 5541 ! Description: 5542 ! ------------ 5543 !> Reads a 5D float variables from dynamic driver, such as time-dependent xy-, 5544 !> xz- or yz-boundary data as well as 5D initialization data. Please note, 5545 !> the passed arguments are start indices and number of elements in each 5546 !> dimension, which is in contrast to the other 3d versions where start- and 5547 !> end indices are passed. The different handling of 5D dynamic variables is 5548 !> due to its asymmetry for the u- and v component. 5549 !> NOTE(1) - This subroutine is more flexible than get_variable_xd_real as it 5550 !> provides much better control over starting and count indices 5551 !> (ecc 20190418) 5552 !> NOTE(2) - This subroutine is used specific for reading NC variable 5553 !> emission_values having a "z" dimension. Said dimension 5554 !> is to be removed in the future and this subroutine shall 5555 !> be depreciated accordingly (ecc 20190418) 5556 !------------------------------------------------------------------------------! 5557 5558 SUBROUTINE get_variable_5d_real_dynamic( id, variable_name, var, & 5559 i1s, i2s, i3s, i4s, i5s, & 5560 count_1, count_2, count_3, count_4, count_5, & 5561 par_access ) 5562 5563 USE indices 5564 USE pegrid 5565 5566 IMPLICIT NONE 5567 5568 CHARACTER(LEN=*) :: variable_name !< variable name 5569 5570 LOGICAL :: par_access !< additional flag indicating parallel read 5571 5572 INTEGER(iwp) :: count_1 !< # elements read in dimension 1 wrt file 5573 INTEGER(iwp) :: count_2 !< # elements read in dimension 2 wrt file 5574 INTEGER(iwp) :: count_3 !< # elements read in dimension 3 wrt file 5575 INTEGER(iwp) :: count_4 !< # elements read in dimension 4 wrt file 5576 INTEGER(iwp) :: count_5 !< # elements read in dimension 5 wrt file 5577 INTEGER(iwp) :: i1 !< index for dimension 1 on file 5578 INTEGER(iwp) :: i1s !< starting index for dimension 1 hyperslab 5579 INTEGER(iwp) :: i2 !< index for dimension 2 on file 5580 INTEGER(iwp) :: i2s !< starting index for dimension 2 hyperslab 5581 INTEGER(iwp) :: i3 !< index for dimension 3 on file 5582 INTEGER(iwp) :: i3s !< starting index for dimension 3 hyperslab 5583 INTEGER(iwp) :: i4 !< index for dimension 4 on file 5584 INTEGER(iwp) :: i4s !< starting index for dimension 4 hyperslab 5585 INTEGER(iwp) :: i5 !< index for dimension 5 on file 5586 INTEGER(iwp) :: i5s !< starting index for dimension 5 hyperslab 5587 INTEGER(iwp) :: id_var !< netCDF variable id (varid) 5588 INTEGER(iwp) :: lb1 !< lower bound of dimension 1 wrt file 5589 INTEGER(iwp) :: lb2 !< lower bound of dimension 2 wrt file 5590 INTEGER(iwp) :: lb3 !< lower bound of dimension 3 wrt file 5591 INTEGER(iwp) :: lb4 !< lower bound of dimension 4 wrt file 5592 INTEGER(iwp) :: lb5 !< lower bound of dimension 5 wrt file 5593 INTEGER(iwp) :: ub1 !< upper bound of dimension 1 wrt file 5594 INTEGER(iwp) :: ub2 !< upper bound of dimension 2 wrt file 5595 INTEGER(iwp) :: ub3 !< upper bound of dimension 3 wrt file 5596 INTEGER(iwp) :: ub4 !< upper bound of dimension 4 wrt file 5597 INTEGER(iwp) :: ub5 !< upper bound of dimension 5 wrt file 5598 INTEGER(iwp), INTENT(IN) :: id !< netCDF file id (ncid) 5599 5600 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: tmp !< temporary variable to read data 5601 !< from file according is reverse 5602 !< array index order 5603 REAL(wp), DIMENSION(:,:,:,:,:), INTENT(INOUT) :: var !< input variable 5604 5605 #if defined( __netcdf ) 5606 5607 ! 5608 !-- Inquire variable id. 5609 5610 nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var ) 5611 5612 ! 5613 !-- Check for collective read-operation and set respective NetCDF flags if required. 5614 !-- Please note, in contrast to the other input routines where each PEs 5615 !-- reads its subdomain data, dynamic input data not by all PEs, only 5616 !-- by those which encompass lateral model boundaries. Hence, collective 5617 !-- read operations are only enabled for top-boundary data. 5618 5619 IF ( collective_read .AND. par_access ) THEN 5620 5621 #if defined( __netcdf4_parallel ) 5622 nc_stat = NF90_VAR_PAR_ACCESS (id, id_var, NF90_COLLECTIVE) 5623 #endif 5624 5625 ENDIF 5626 5627 ! 5628 !-- Allocate temporary variable according to memory access on file. 5629 !-- Therefore, determine dimension bounds of input array. 5630 5631 lb1 = LBOUND(var,5) 5632 ub1 = UBOUND(var,5) 5633 lb2 = LBOUND(var,4) 5634 ub2 = UBOUND(var,4) 5635 lb3 = LBOUND(var,3) 5636 ub3 = UBOUND(var,3) 5637 lb4 = LBOUND(var,2) 5638 ub4 = UBOUND(var,2) 5639 lb5 = LBOUND(var,1) 5640 ub5 = UBOUND(var,1) 5641 ALLOCATE ( tmp(lb1:ub1,lb2:ub2,lb3:ub3,lb4:ub4,lb5:ub5) ) 5642 5643 ! 5644 !-- Get variable 5645 5646 nc_stat = NF90_GET_VAR( id, id_var, tmp, & 5647 start = (/ i1s, i2s, i3s, i4s, i5s /), & 5648 count = (/ count_1, count_2, count_3, count_4, count_5 /) ) 5649 5650 CALL handle_error( 'get_variable_3d_real_dynamic', 537, variable_name ) 5651 5652 ! 5653 !-- Assign temp array to output. Note reverse index order 5654 5655 DO i5 = lb5, ub5 5656 DO i4 = lb4, ub4 5657 DO i3 = lb3, ub3 5658 DO i2 = lb2, ub2 5659 DO i1 = lb1, ub1 5660 var(i5,i4,i3,i2,i1) = tmp(i1,i2,i3,i4,i5) 5661 ENDDO 5662 ENDDO 5663 ENDDO 5664 ENDDO 5665 ENDDO 5666 5667 DEALLOCATE( tmp ) 5668 5669 #endif 5670 5671 END SUBROUTINE get_variable_5d_real_dynamic 5672 5673 5674 !------------------------------------------------------------------------------! 5255 END SUBROUTINE get_variable_5d_real_dynamic 5256 5257 5258 !--------------------------------------------------------------------------------------------------! 5675 5259 ! Description: 5676 5260 ! ------------ 5677 5261 !> Inquires the number of variables in a file 5678 !------------------------------------------------------------------------------! 5679 SUBROUTINE inquire_num_variables( id, num_vars ) 5680 5681 USE indices 5682 USE pegrid 5683 5684 IMPLICIT NONE 5685 5686 INTEGER(iwp), INTENT(IN) :: id !< file id 5687 INTEGER(iwp), INTENT(INOUT) :: num_vars !< number of variables in a file 5262 !--------------------------------------------------------------------------------------------------! 5263 SUBROUTINE inquire_num_variables( id, num_vars ) 5264 5265 USE indices 5266 USE pegrid 5267 5268 IMPLICIT NONE 5269 5270 INTEGER(iwp), INTENT(IN) :: id !< file id 5271 INTEGER(iwp), INTENT(INOUT) :: num_vars !< number of variables in a file 5272 5273 5688 5274 #if defined( __netcdf ) 5689 5690 nc_stat = NF90_INQUIRE( id, NVARIABLES = num_vars ) 5691 CALL handle_error( 'inquire_num_variables', 539 ) 5692 5275 nc_stat = NF90_INQUIRE( id, NVARIABLES = num_vars ) 5276 CALL handle_error( 'inquire_num_variables', 539 ) 5693 5277 #endif 5694 END SUBROUTINE inquire_num_variables 5695 5696 5697 !------------------------------------------------------------------------------! 5278 5279 END SUBROUTINE inquire_num_variables 5280 5281 5282 !--------------------------------------------------------------------------------------------------! 5698 5283 ! Description: 5699 5284 ! ------------ 5700 5285 !> Inquires the variable names belonging to a file. 5701 !------------------------------------------------------------------------------! 5702 SUBROUTINE inquire_variable_names( id, var_names ) 5703 5704 USE indices 5705 USE pegrid 5706 5707 IMPLICIT NONE 5708 5709 CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: var_names !< return variable - variable names 5710 INTEGER(iwp) :: i !< loop variable 5711 INTEGER(iwp), INTENT(IN) :: id !< file id 5712 INTEGER(iwp) :: num_vars !< number of variables (unused return parameter) 5713 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: varids !< dummy array to strore variable ids temporarily 5286 !--------------------------------------------------------------------------------------------------! 5287 SUBROUTINE inquire_variable_names( id, var_names ) 5288 5289 USE indices 5290 USE pegrid 5291 5292 IMPLICIT NONE 5293 5294 CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) :: var_names !< return variable - variable names 5295 5296 INTEGER(iwp) :: i !< loop variable 5297 INTEGER(iwp), INTENT(IN) :: id !< file id 5298 INTEGER(iwp) :: num_vars !< number of variables (unused return parameter) 5299 5300 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: varids !< dummy array to strore variable ids temporarily 5301 5302 5714 5303 #if defined( __netcdf ) 5715 5716 ALLOCATE( varids(1:SIZE(var_names)) ) 5717 nc_stat = NF90_INQ_VARIDS( id, NVARS = num_vars, VARIDS = varids ) 5304 ALLOCATE( varids(1:SIZE(var_names)) ) 5305 nc_stat = NF90_INQ_VARIDS( id, NVARS = num_vars, VARIDS = varids ) 5306 CALL handle_error( 'inquire_variable_names', 540 ) 5307 5308 DO i = 1, SIZE(var_names) 5309 nc_stat = NF90_INQUIRE_VARIABLE( id, varids(i), NAME = var_names(i) ) 5718 5310 CALL handle_error( 'inquire_variable_names', 540 ) 5719 5720 DO i = 1, SIZE(var_names) 5721 nc_stat = NF90_INQUIRE_VARIABLE( id, varids(i), NAME = var_names(i) ) 5722 CALL handle_error( 'inquire_variable_names', 540 ) 5723 ENDDO 5724 5725 DEALLOCATE( varids ) 5311 ENDDO 5312 5313 DEALLOCATE( varids ) 5726 5314 #endif 5727 END SUBROUTINE inquire_variable_names 5728 5729 !------------------------------------------------------------------------------! 5315 5316 END SUBROUTINE inquire_variable_names 5317 5318 5319 !--------------------------------------------------------------------------------------------------! 5730 5320 ! Description: 5731 5321 ! ------------ 5732 5322 !> Inquires the _FillValue settings of an integer variable. 5733 !------------------------------------------------------------------------------! 5734 SUBROUTINE inquire_fill_value_int( id, var_name, nofill, fill_value ) 5735 5736 CHARACTER(LEN=*), INTENT(IN) :: var_name !< variable name 5737 5738 INTEGER(iwp), INTENT(IN) :: id !< file id 5739 INTEGER(iwp) :: nofill !< flag indicating whether fill values are set or not 5740 INTEGER(iwp) :: fill_value !< fill value 5741 INTEGER(iwp) :: id_var !< netCDF variable id (varid) 5323 !--------------------------------------------------------------------------------------------------! 5324 SUBROUTINE inquire_fill_value_int( id, var_name, nofill, fill_value ) 5325 5326 CHARACTER(LEN=*), INTENT(IN) :: var_name !< variable name 5327 5328 INTEGER(iwp), INTENT(IN) :: id !< file id 5329 INTEGER(iwp) :: id_var !< netCDF variable id (varid) 5330 INTEGER(iwp) :: fill_value !< fill value 5331 INTEGER(iwp) :: nofill !< flag indicating whether fill values are set or not 5332 5742 5333 5743 5334 #if defined( __netcdf ) 5744 5745 5335 nc_stat = NF90_INQ_VARID( id, TRIM( var_name ), id_var ) 5336 nc_stat = NF90_INQ_VAR_FILL(id, id_var, no_fill, fill_value ) 5746 5337 #endif 5747 5338 ! 5748 !-- Further line is just to avoid compiler warnings. nofill might be used5749 !-- in future. 5750 IF ( nofill == 0 .OR. nofill /= 0 ) CONTINUE 5751 5752 END SUBROUTINE inquire_fill_value_int 5753 5754 !------------------------------------------------------------------------------ !5339 !-- Further line is just to avoid compiler warnings. nofill might be used in future. 5340 IF ( nofill == 0 .OR. nofill /= 0 ) CONTINUE 5341 5342 END SUBROUTINE inquire_fill_value_int 5343 5344 5345 !--------------------------------------------------------------------------------------------------! 5755 5346 ! Description: 5756 5347 ! ------------ 5757 5348 !> Inquires the _FillValue settings of a real variable. 5758 !------------------------------------------------------------------------------ !5759 5760 5761 5762 5763 5764 INTEGER(iwp) :: nofill !< flag indicating whether fill values are set or not5765 INTEGER(iwp) :: id_var !< netCDF variable id (varid)5349 !--------------------------------------------------------------------------------------------------! 5350 SUBROUTINE inquire_fill_value_real( id, var_name, nofill, fill_value ) 5351 5352 CHARACTER(LEN=*), INTENT(IN) :: var_name !< variable name 5353 5354 INTEGER(iwp), INTENT(IN) :: id !< file id 5355 INTEGER(iwp) :: id_var !< netCDF variable id (varid) 5356 INTEGER(iwp) :: nofill !< flag indicating whether fill values are set or not 5766 5357 5767 5358 #if defined( __imuk_old ) 5768 5359 INTEGER(iwp) :: fill_value_int !< fill value workaround 5769 5360 #endif 5770 REAL(wp), INTENT(OUT) :: fill_value !< fill value 5361 REAL(wp), INTENT(OUT) :: fill_value !< fill value 5362 5771 5363 5772 5364 #if defined( __netcdf ) 5773 5365 nc_stat = NF90_INQ_VARID( id, TRIM( var_name ), id_var ) 5774 5366 #if defined( __imuk_old ) 5775 5776 5367 nc_stat = NF90_INQ_VAR_FILL(id, id_var, no_fill, fill_value_int ) 5368 fill_value = fill_value_int 5777 5369 #else 5778 5370 nc_stat = NF90_INQ_VAR_FILL(id, id_var, no_fill, fill_value ) 5779 5371 #endif 5780 5372 #endif 5781 5373 ! 5782 !-- Further line is just to avoid compiler warnings. nofill might be used5783 !-- in future. 5784 IF ( nofill == 0 .OR. nofill /= 0 ) CONTINUE 5785 5786 END SUBROUTINE inquire_fill_value_real 5787 5788 !------------------------------------------------------------------------------ !5374 !-- Further line is just to avoid compiler warnings. nofill might be used in future. 5375 IF ( nofill == 0 .OR. nofill /= 0 ) CONTINUE 5376 5377 END SUBROUTINE inquire_fill_value_real 5378 5379 5380 !--------------------------------------------------------------------------------------------------! 5789 5381 ! Description: 5790 5382 ! ------------ 5791 5383 !> Prints out a text message corresponding to the current status. 5792 !------------------------------------------------------------------------------! 5793 SUBROUTINE handle_error( routine_name, errno, name ) 5794 5795 USE control_parameters, & 5796 ONLY: message_string 5797 5798 IMPLICIT NONE 5799 5800 CHARACTER(LEN=6) :: message_identifier !< string for the error number 5801 CHARACTER(LEN=*) :: routine_name !< routine name where the error happened 5802 CHARACTER(LEN=*), OPTIONAL :: name !< name of variable where reading failed 5803 5804 INTEGER(iwp) :: errno 5384 !--------------------------------------------------------------------------------------------------! 5385 SUBROUTINE handle_error( routine_name, errno, name ) 5386 5387 USE control_parameters, & 5388 ONLY: message_string 5389 5390 IMPLICIT NONE 5391 5392 CHARACTER(LEN=6) :: message_identifier !< string for the error number 5393 CHARACTER(LEN=*), OPTIONAL :: name !< name of variable where reading failed 5394 CHARACTER(LEN=*) :: routine_name !< routine name where the error happened 5395 5396 INTEGER(iwp) :: errno 5397 5398 5805 5399 #if defined( __netcdf ) 5806 5807 IF ( nc_stat /= NF90_NOERR ) THEN 5808 5809 WRITE( message_identifier, '(''NC'',I4.4)' ) errno 5810 5811 IF ( PRESENT( name ) ) THEN 5812 message_string = "Problem reading attribute/variable - " // & 5813 TRIM(name) // ": " // & 5814 TRIM( NF90_STRERROR( nc_stat ) ) 5815 ELSE 5816 message_string = TRIM( NF90_STRERROR( nc_stat ) ) 5817 ENDIF 5818 5819 CALL message( routine_name, message_identifier, 2, 2, myid, 6, 1 ) 5820 5400 IF ( nc_stat /= NF90_NOERR ) THEN 5401 5402 WRITE( message_identifier, '(''NC'',I4.4)' ) errno 5403 5404 IF ( PRESENT( name ) ) THEN 5405 message_string = "Problem reading attribute/variable - " // & 5406 TRIM(name) // ": " // TRIM( NF90_STRERROR( nc_stat ) ) 5407 ELSE 5408 message_string = TRIM( NF90_STRERROR( nc_stat ) ) 5821 5409 ENDIF 5822 5410 5411 CALL message( routine_name, message_identifier, 2, 2, myid, 6, 1 ) 5412 5413 ENDIF 5823 5414 #endif 5824 END SUBROUTINE handle_error 5415 5416 END SUBROUTINE handle_error 5825 5417 5826 5418
Note: See TracChangeset
for help on using the changeset viewer.
