source: palm/trunk/SOURCE/nesting_offl_mod.f90

Last change on this file was 4843, checked in by raasch, 3 years ago

local namelist parameter added to switch off the module although the respective module namelist appears in the namelist file, further copyright updates

  • Property svn:keywords set to Id
File size: 174.2 KB
Line 
1!> @file nesting_offl_mod.f90
2!--------------------------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the 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/>.
15!
16! Copyright 1997-2021 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------------------------!
18!
19! Current revisions:
20! ------------------
21!
22!
23! Former revisions:
24! -----------------
25! $Id: nesting_offl_mod.f90 4843 2021-01-15 15:22:11Z banzhafs $
26! local namelist parameter added to switch off the module although the respective module namelist
27! appears in the namelist file
28!
29! 4842 2021-01-14 10:42:28Z raasch
30! reading of namelist file and actions in case of namelist errors revised so that statement labels
31! and goto statements are not required any more
32!
33! 4834 2021-01-07 10:28:00Z raasch
34! file re-formatted to follow the PALM coding standard
35!
36! 4828 2021-01-05 11:21:41Z Giersch
37! Bugfix in obtaining the correct timestamp in case of restart runs
38!
39! 4724 2020-10-06 17:20:39Z suehring $
40! - Enable LOD=1 input of boundary conditions
41! - Minor bugfix - add missing initialization of the top boundary
42!
43! 4582 2020-06-29 09:22:11Z suehring
44! Remove unused variable
45!
46! 4581 2020-06-29 08:49:58Z suehring
47! Omit explicit pressure forcing via geostrophic wind components in case of mesoscale nesting.
48!
49! 4561 2020-06-12 07:05:56Z suehring
50! Adapt mass-flux correction also for the anelastic approximation
51!
52! 4561 2020-06-12 07:05:56Z suehring
53! use statement for exchange horiz added
54!
55! 4360 2020-01-07 11:25:50Z suehring
56! Bugfix, time coordinate is relative to origin_time rather than to 00:00:00 UTC.
57!
58! 4346 2019-12-18 11:55:56Z motisi
59! Introduction of wall_flags_total_0, which currently sets bits based on static topography
60! information used in wall_flags_static_0
61!
62! 4329 2019-12-10 15:46:36Z motisi
63! Renamed wall_flags_0 to wall_flags_static_0
64!
65! 4286 2019-10-30 16:01:14Z resler
66! Fix wrong checks of time from dynamic driver in nesting_offl_mod
67!
68! 4273 2019-10-24 13:40:54Z monakurppa
69! Add a logical switch nesting_offline_chem
70!
71! 4270 2019-10-23 10:46:20Z monakurppa
72! Implement offline nesting for salsa variables.
73!
74! 4231 2019-09-12 11:22:00Z suehring
75! Bugfix in array deallocation
76!
77! 4230 2019-09-11 13:58:14Z suehring
78! Update mean chemistry profiles. These are also used for rayleigh damping.
79!
80! 4227 2019-09-10 18:04:34Z gronemeier
81! implement new palm_date_time_mod
82!
83! - Data input moved into nesting_offl_mod
84! - check rephrased
85! - time variable is now relative to time_utc_init
86! - Define module specific data type for offline nesting in nesting_offl_mod
87!
88! 4182 2019-08-22 15:20:23Z scharf
89! Corrected "Former revisions" section
90!
91! 4169 2019-08-19 13:54:35Z suehring
92! Additional check added.
93!
94! 4168 2019-08-16 13:50:17Z suehring
95! Replace function get_topography_top_index by topo_top_ind
96!
97! 4125 2019-07-29 13:31:44Z suehring
98! In order to enable netcdf parallel access, allocate dummy arrays for the lateral boundary data on
99! cores that actually do not belong to these boundaries.
100!
101! 4079 2019-07-09 18:04:41Z suehring
102! - Set boundary condition for w at nzt+1 at the lateral boundaries, even though these won't enter
103!   the numerical solution. However, due to the mass conservation these values might some up to very
104!   large values which will occur in the run-control file
105! - Bugfix in offline nesting of chemical species
106! - Do not set Neumann conditions for TKE and passive scalar
107!
108! 4022 2019-06-12 11:52:39Z suehring
109! Detection of boundary-layer depth in stable boundary layer on basis of boundary data improved
110! Routine for boundary-layer depth calculation renamed and made public
111!
112! 3987 2019-05-22 09:52:13Z kanani
113! Introduce alternative switch for debug output during timestepping
114!
115! 3964 2019-05-09 09:48:32Z suehring
116! Ensure that veloctiy term in calculation of bulk Richardson number does not become zero
117!
118! 3937 2019-04-29 15:09:07Z suehring
119! Set boundary conditon on upper-left and upper-south grid point for the u- and v-component,
120! respectively.
121!
122! 3891 2019-04-12 17:52:01Z suehring
123! Bugfix, do not overwrite lateral and top boundary data in case of restart runs.
124!
125! 3885 2019-04-11 11:29:34Z kanani
126! Changes related to global restructuring of location messages and introduction of additional debug
127! messages
128!
129!
130! Do local data exchange for chemistry variables only when boundary data is coming from dynamic file
131!
132! 3737 2019-02-12 16:57:06Z suehring
133! Introduce mesoscale nesting for chemical species
134!
135! 3705 2019-01-29 19:56:39Z suehring
136! Formatting adjustments
137!
138! 3704 2019-01-29 19:51:41Z suehring
139! Check implemented for offline nesting in child domain
140!
141! Initial Revision:
142! - separate offline nesting from large_scale_nudging_mod
143! - revise offline nesting, adjust for usage of synthetic turbulence generator
144! - adjust Rayleigh damping depending on the time-depending atmospheric conditions
145!
146!
147! Description:
148! ------------
149!> Offline nesting in larger-scale models. Boundary conditions for the simulation are read from
150!> NetCDF file and are prescribed onto the respective arrays.
151!> Further, a mass-flux correction is performed to maintain the mass balance.
152!--------------------------------------------------------------------------------------------------!
153 MODULE nesting_offl_mod
154
155    USE arrays_3d,                                                                                 &
156        ONLY:  diss,                                                                               &
157               drho_air_zw,                                                                        &
158               dzw,                                                                                &
159               e,                                                                                  &
160               pt,                                                                                 &
161               pt_init,                                                                            &
162               q,                                                                                  &
163               q_init,                                                                             &
164               rdf,                                                                                &
165               rdf_sc,                                                                             &
166               rho_air,                                                                            &
167               rho_air_zw,                                                                         &
168               s,                                                                                  &
169               u,                                                                                  &
170               u_init,                                                                             &
171               ug,                                                                                 &
172               v,                                                                                  &
173               v_init,                                                                             &
174               vg,                                                                                 &
175               w,                                                                                  &
176               zu,                                                                                 &
177               zw
178
179    USE basic_constants_and_equations_mod,                                                         &
180        ONLY:  g,                                                                                  &
181               pi
182
183    USE chem_modules,                                                                              &
184        ONLY:  chem_species, nesting_offline_chem
185
186    USE control_parameters,                                                                        &
187        ONLY:  air_chemistry,                                                                      &
188               bc_dirichlet_l,                                                                     &
189               bc_dirichlet_n,                                                                     &
190               bc_dirichlet_r,                                                                     &
191               bc_dirichlet_s,                                                                     &
192               coupling_char,                                                                      &
193               constant_diffusion,                                                                 &
194               child_domain,                                                                       &
195               debug_output_timestep,                                                              &
196               dt_3d,                                                                              &
197               dz,                                                                                 &
198               end_time,                                                                           &
199               humidity,                                                                           &
200               initializing_actions,                                                               &
201               message_string,                                                                     &
202               nesting_offline,                                                                    &
203               neutral,                                                                            &
204               passive_scalar,                                                                     &
205               rans_mode,                                                                          &
206               rans_tke_e,                                                                         &
207               rayleigh_damping_factor,                                                            &
208               rayleigh_damping_height,                                                            &
209               salsa,                                                                              &
210               spinup_time,                                                                        &
211               time_since_reference_point,                                                         &
212               volume_flow
213
214    USE cpulog,                                                                                    &
215        ONLY:  cpu_log,                                                                            &
216               log_point,                                                                          &
217               log_point_s
218
219    USE grid_variables
220
221    USE indices,                                                                                   &
222        ONLY:  nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nys, nysv, nysg, nyn, nyng, nzb, nz, nzt, &
223               topo_top_ind, wall_flags_total_0
224
225    USE kinds
226
227    USE netcdf_data_input_mod,                                                                     &
228        ONLY:  char_fill,                                                                          &
229               char_lod,                                                                           &
230               check_existence,                                                                    &
231               close_input_file,                                                                   &
232               get_attribute,                                                                      &
233               get_dimension_length,                                                               &
234               get_variable,                                                                       &
235               get_variable_pr,                                                                    &
236               input_pids_dynamic,                                                                 &
237               inquire_num_variables,                                                              &
238               inquire_variable_names,                                                             &
239               input_file_dynamic,                                                                 &
240               num_var_pids,                                                                       &
241               open_read_file,                                                                     &
242               pids_id
243
244    USE pegrid
245
246    USE salsa_mod,                                                                                 &
247        ONLY:  salsa_nesting_offl_bc,                                                              &
248               salsa_nesting_offl_init,                                                            &
249               salsa_nesting_offl_input
250
251    IMPLICIT NONE
252
253!
254!-- Define data type for nesting in larger-scale models like COSMO.
255!-- Data type comprises u, v, w, pt, and q at lateral and top boundaries.
256    TYPE nest_offl_type
257
258       CHARACTER(LEN=16) ::  char_l = 'ls_forcing_left_'   !< leading substring for variables at left boundary
259       CHARACTER(LEN=17) ::  char_n = 'ls_forcing_north_'  !< leading substring for variables at north boundary
260       CHARACTER(LEN=17) ::  char_r = 'ls_forcing_right_'  !< leading substring for variables at right boundary
261       CHARACTER(LEN=17) ::  char_s = 'ls_forcing_south_'  !< leading substring for variables at south boundary
262       CHARACTER(LEN=15) ::  char_t = 'ls_forcing_top_'    !< leading substring for variables at top boundary
263
264       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names         !< list of variable in dynamic input file
265       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_l  !< names of mesoscale nested chemistry variables at left
266                                                                           !< boundary
267       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_n  !< names of mesoscale nested chemistry variables at north
268                                                                           !< boundary
269       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_r  !< names of mesoscale nested chemistry variables at right
270                                                                           !< boundary
271       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_s  !< names of mesoscale nested chemistry variables at south
272                                                                           !< boundary
273       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names_chem_t  !< names of mesoscale nested chemistry variables at top
274                                                                           !< boundary
275
276       INTEGER(iwp) ::  lod_east_pt  = 2  !< level-of-detail of input data of potential temperature at the eastern boundary
277       INTEGER(iwp) ::  lod_east_qc  = 2  !< level-of-detail of input data of cloud-water mixture fraction at the eastern boundary
278       INTEGER(iwp) ::  lod_east_qv  = 2  !< level-of-detail of input data of specific humidity at the eastern boundary
279       INTEGER(iwp) ::  lod_east_u   = 2  !< level-of-detail of input data of the u-component at the eastern boundary
280       INTEGER(iwp) ::  lod_east_v   = 2  !< level-of-detail of input data of the v-component at the eastern boundary
281       INTEGER(iwp) ::  lod_east_w   = 2  !< level-of-detail of input data of the w-component at the eastern boundary
282       INTEGER(iwp) ::  lod_north_pt = 2  !< level-of-detail of input data of potential temperature at the northern boundary
283       INTEGER(iwp) ::  lod_north_qc = 2  !< level-of-detail of input data of cloud-water mixture fraction at the northern boundary
284       INTEGER(iwp) ::  lod_north_qv = 2  !< level-of-detail of input data of specific humidity at the northern boundary
285       INTEGER(iwp) ::  lod_north_u  = 2  !< level-of-detail of input data of the u-component at the northern boundary
286       INTEGER(iwp) ::  lod_north_v  = 2  !< level-of-detail of input data of the v-component at the northern boundary
287       INTEGER(iwp) ::  lod_north_w  = 2  !< level-of-detail of input data of the w-component at the northern boundary
288       INTEGER(iwp) ::  lod_south_pt = 2  !< level-of-detail of input data of potential temperature at the southern boundary
289       INTEGER(iwp) ::  lod_south_qc = 2  !< level-of-detail of input data of cloud-water mixture fraction at the southern boundary
290       INTEGER(iwp) ::  lod_south_qv = 2  !< level-of-detail of input data of specific humidity at the southern boundary
291       INTEGER(iwp) ::  lod_south_u  = 2  !< level-of-detail of input data of the u-component at the southern boundary
292       INTEGER(iwp) ::  lod_south_v  = 2  !< level-of-detail of input data of the v-component at the southern boundary
293       INTEGER(iwp) ::  lod_south_w  = 2  !< level-of-detail of input data of the w-component at the southern boundary
294       INTEGER(iwp) ::  lod_top_pt   = 2  !< level-of-detail of input data of potential temperature at the top boundary
295       INTEGER(iwp) ::  lod_top_qc   = 2  !< level-of-detail of input data of cloud-water mixture fraction at the top boundary
296       INTEGER(iwp) ::  lod_top_qv   = 2  !< level-of-detail of input data of specific humidity at the top boundary
297       INTEGER(iwp) ::  lod_top_u    = 2  !< level-of-detail of input data of the u-component at the top boundary
298       INTEGER(iwp) ::  lod_top_v    = 2  !< level-of-detail of input data of the v-component at the top boundary
299       INTEGER(iwp) ::  lod_top_w    = 2  !< level-of-detail of input data of the w-component at the top boundary
300       INTEGER(iwp) ::  lod_west_pt  = 2  !< level-of-detail of input data of potential temperature at the western boundary
301       INTEGER(iwp) ::  lod_west_qc  = 2  !< level-of-detail of input data of cloud-water mixture fraction at the western boundary
302       INTEGER(iwp) ::  lod_west_qv  = 2  !< level-of-detail of input data of specific humidity at the western boundary
303       INTEGER(iwp) ::  lod_west_u   = 2  !< level-of-detail of input data of the u-component at the western boundary
304       INTEGER(iwp) ::  lod_west_v   = 2  !< level-of-detail of input data of the v-component at the western boundary
305       INTEGER(iwp) ::  lod_west_w   = 2  !< level-of-detail of input data of the w-component at the western boundary
306       INTEGER(iwp) ::  nt                !< number of time levels in dynamic input file
307       INTEGER(iwp) ::  nzu               !< number of vertical levels on scalar grid in dynamic input file
308       INTEGER(iwp) ::  nzw               !< number of vertical levels on w grid in dynamic input file
309       INTEGER(iwp) ::  tind = 0          !< time index for reference time in mesoscale-offline nesting
310       INTEGER(iwp) ::  tind_p = 0        !< time index for following time in mesoscale-offline nesting
311
312       LOGICAL      ::  init = .FALSE.    !< flag indicating that offline nesting is already initialized
313
314       LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_l  !< flags inidicating whether left boundary data for chemistry is in
315                                                                !< dynamic input file
316       LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_n  !< flags inidicating whether north boundary data for chemistry is in
317                                                                !< dynamic input file
318       LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_r  !< flags inidicating whether right boundary data for chemistry is in
319                                                                !< dynamic input file
320       LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_s  !< flags inidicating whether south boundary data for chemistry is in
321                                                                !< dynamic input file
322       LOGICAL, DIMENSION(:), ALLOCATABLE ::  chem_from_file_t  !< flags inidicating whether top boundary data for chemistry is in
323                                                                !< dynamic input file
324
325       REAL(wp), DIMENSION(:), ALLOCATABLE ::  surface_pressure  !< time dependent surface pressure
326       REAL(wp), DIMENSION(:), ALLOCATABLE ::  time              !< time levels in dynamic input file
327       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu_atmos          !< vertical levels at scalar grid in dynamic input file
328       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zw_atmos          !< vertical levels at w grid in dynamic input file
329
330       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ug         !< domain-averaged geostrophic component
331       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  vg         !< domain-averaged geostrophic component
332
333       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_l     !< potentital temperautre at left boundary
334       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_n     !< potentital temperautre at north boundary
335       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_r     !< potentital temperautre at right boundary
336       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_s     !< potentital temperautre at south boundary
337       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_top   !< potentital temperautre at top boundary
338       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_l      !< mixing ratio at left boundary
339       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_n      !< mixing ratio at north boundary
340       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_r      !< mixing ratio at right boundary
341       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_s      !< mixing ratio at south boundary
342       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_top    !< mixing ratio at top boundary
343       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_l      !< u-component at left boundary
344       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_n      !< u-component at north boundary
345       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_r      !< u-component at right boundary
346       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_s      !< u-component at south boundary
347       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_top    !< u-component at top boundary
348       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_l      !< v-component at left boundary
349       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_n      !< v-component at north boundary
350       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_r      !< v-component at right boundary
351       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_s      !< v-component at south boundary
352       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_top    !< v-component at top boundary
353       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_l      !< w-component at left boundary
354       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_n      !< w-component at north boundary
355       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_r      !< w-component at right boundary
356       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_s      !< w-component at south boundary
357       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_top    !< w-component at top boundary
358
359       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_l   !< chemical species at left boundary
360       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_n   !< chemical species at north boundary
361       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_r   !< chemical species at right boundary
362       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_s   !< chemical species at south boundary
363       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  chem_top !< chemical species at left boundary
364
365    END TYPE nest_offl_type
366
367    INTEGER(iwp) ::  i_bound     !< boundary grid point in x-direction for scalars, v, and w
368    INTEGER(iwp) ::  i_bound_u   !< boundary grid point in x-direction for u
369    INTEGER(iwp) ::  i_end       !< end index for array allocation along x-direction at norther/southern boundary
370    INTEGER(iwp) ::  i_start     !< start index for array allocation along x-direction at norther/southern boundary (scalars, v, w)
371    INTEGER(iwp) ::  i_start_u   !< start index for array allocation along x-direction at norther/southern boundary (u)
372    INTEGER(iwp) ::  j_bound     !< boundary grid point in y-direction for scalars, u, and w
373    INTEGER(iwp) ::  j_bound_v   !< boundary grid point in y-direction for v
374    INTEGER(iwp) ::  j_end       !< end index for array allocation along y-direction at eastern/western boundary
375    INTEGER(iwp) ::  j_start     !< start index for array allocation along y-direction at eastern/western boundary (scalars, u, w)
376    INTEGER(iwp) ::  j_start_v   !< start index for array allocation along y-direction at eastern/western boundary (v)
377    INTEGER(iwp) ::  lod         !< level-of-detail of lateral input data
378
379    REAL(wp) ::  fac_dt              !< interpolation factor
380    REAL(wp) ::  zi_ribulk = 0.0_wp  !< boundary-layer depth according to bulk Richardson criterion, i.e. the height where Ri_bulk
381                                     !< exceeds the critical bulk Richardson number of 0.2
382
383    TYPE(nest_offl_type) ::  nest_offl  !< data structure for data input at lateral and top boundaries (provided by Inifor)
384
385    SAVE
386    PRIVATE
387!
388!-- Public subroutines
389    PUBLIC nesting_offl_bc,                                                                        &
390           nesting_offl_calc_zi,                                                                   &
391           nesting_offl_check_parameters,                                                          &
392           nesting_offl_geostrophic_wind,                                                          &
393           nesting_offl_header,                                                                    &
394           nesting_offl_init,                                                                      &
395           nesting_offl_input,                                                                     &
396           nesting_offl_interpolation_factor,                                                      &
397           nesting_offl_mass_conservation,                                                         &
398           nesting_offl_parin
399!
400!-- Public variables
401    PUBLIC zi_ribulk
402
403    INTERFACE nesting_offl_bc
404       MODULE PROCEDURE nesting_offl_bc
405    END INTERFACE nesting_offl_bc
406
407    INTERFACE nesting_offl_calc_zi
408       MODULE PROCEDURE nesting_offl_calc_zi
409    END INTERFACE nesting_offl_calc_zi
410
411    INTERFACE nesting_offl_check_parameters
412       MODULE PROCEDURE nesting_offl_check_parameters
413    END INTERFACE nesting_offl_check_parameters
414
415    INTERFACE nesting_offl_geostrophic_wind
416       MODULE PROCEDURE nesting_offl_geostrophic_wind
417    END INTERFACE nesting_offl_geostrophic_wind
418
419    INTERFACE nesting_offl_header
420       MODULE PROCEDURE nesting_offl_header
421    END INTERFACE nesting_offl_header
422
423    INTERFACE nesting_offl_init
424       MODULE PROCEDURE nesting_offl_init
425    END INTERFACE nesting_offl_init
426
427    INTERFACE nesting_offl_input
428       MODULE PROCEDURE nesting_offl_input
429    END INTERFACE nesting_offl_input
430
431    INTERFACE nesting_offl_interpolation_factor
432       MODULE PROCEDURE nesting_offl_interpolation_factor
433    END INTERFACE nesting_offl_interpolation_factor
434
435    INTERFACE nesting_offl_mass_conservation
436       MODULE PROCEDURE nesting_offl_mass_conservation
437    END INTERFACE nesting_offl_mass_conservation
438
439    INTERFACE nesting_offl_parin
440       MODULE PROCEDURE nesting_offl_parin
441    END INTERFACE nesting_offl_parin
442
443 CONTAINS
444
445!--------------------------------------------------------------------------------------------------!
446! Description:
447! ------------
448!> Reads data at lateral and top boundaries derived from larger-scale model.
449!--------------------------------------------------------------------------------------------------!
450 SUBROUTINE nesting_offl_input
451
452    INTEGER(iwp) ::  n   !< running index for chemistry variables
453
454!
455!-- Initialize INIFOR forcing in first call.
456    IF ( .NOT. nest_offl%init )  THEN
457#if defined ( __netcdf )
458!
459!--    Open file in read-only mode
460       CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), pids_id )
461!
462!--    At first, inquire all variable names.
463       CALL inquire_num_variables( pids_id, num_var_pids )
464!
465!--    Allocate memory to store variable names.
466       ALLOCATE( nest_offl%var_names(1:num_var_pids) )
467       CALL inquire_variable_names( pids_id, nest_offl%var_names )
468!
469!--    Read time dimension, allocate memory and finally read time array
470       CALL get_dimension_length( pids_id, nest_offl%nt, 'time' )
471
472       IF ( check_existence( nest_offl%var_names, 'time' ) )  THEN
473          ALLOCATE( nest_offl%time(0:nest_offl%nt-1) )
474          CALL get_variable( pids_id, 'time', nest_offl%time )
475       ENDIF
476!
477!--    Read vertical dimension of scalar und w grid
478       CALL get_dimension_length( pids_id, nest_offl%nzu, 'z' )
479       CALL get_dimension_length( pids_id, nest_offl%nzw, 'zw' )
480
481       IF ( check_existence( nest_offl%var_names, 'z' ) )  THEN
482          ALLOCATE( nest_offl%zu_atmos(1:nest_offl%nzu) )
483          CALL get_variable( pids_id, 'z', nest_offl%zu_atmos )
484       ENDIF
485       IF ( check_existence( nest_offl%var_names, 'zw' ) )  THEN
486          ALLOCATE( nest_offl%zw_atmos(1:nest_offl%nzw) )
487          CALL get_variable( pids_id, 'zw', nest_offl%zw_atmos )
488       ENDIF
489!
490!--    Read surface pressure
491       IF ( check_existence( nest_offl%var_names, 'surface_forcing_surface_pressure' ) )  THEN
492          ALLOCATE( nest_offl%surface_pressure(0:nest_offl%nt-1) )
493          CALL get_variable( pids_id, 'surface_forcing_surface_pressure',                          &
494                             nest_offl%surface_pressure )
495       ENDIF
496!
497!--    Close input file
498       CALL close_input_file( pids_id )
499#endif
500    ENDIF
501!
502!-- Check if dynamic driver data input is required.
503    IF ( nest_offl%time(nest_offl%tind_p) <= MAX( time_since_reference_point, 0.0_wp)  .OR.        &
504         .NOT.  nest_offl%init )  THEN
505       CONTINUE
506!
507!-- Return otherwise
508    ELSE
509       RETURN
510    ENDIF
511!
512!-- Start of CPU measurement
513    CALL cpu_log( log_point_s(86), 'NetCDF input forcing', 'start' )
514
515!
516!-- Obtain time index for current point in time. Note, the time coordinate in the input file is
517!-- always relative to the initial time in UTC, i.e. the time coordinate always starts at 0.0 even
518!-- if the initial UTC is e.g. 7200.0. Further, since time_since_reference_point is negativ here
519!-- when spinup is applied, use MAX function to obtain correct time index.
520    nest_offl%tind = MINLOC( ABS( nest_offl%time - MAX( time_since_reference_point, 0.0_wp ) ),    &
521                             DIM = 1 ) - 1
522!
523!--    Note, in case of restart runs, the time index for the boundary data may indicate a time in
524!--    the future. This needs to be checked and corrected.
525       IF ( TRIM( initializing_actions ) == 'read_restart_data'  .AND.                             &
526            nest_offl%time(nest_offl%tind) > time_since_reference_point )  THEN
527          nest_offl%tind = nest_offl%tind - 1
528       ENDIF
529    nest_offl%tind_p = nest_offl%tind + 1
530!
531!-- Open file in read-only mode
532#if defined ( __netcdf )
533    CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), pids_id )
534!
535!--    Read geostrophic wind components
536!        DO  t = nest_offl%tind, nest_offl%tind_p
537!           CALL get_variable_pr( pids_id, 'ls_forcing_ug', t+1,                 &
538!                                 nest_offl%ug(t-nest_offl%tind,nzb+1:nzt) )
539!           CALL get_variable_pr( pids_id, 'ls_forcing_vg', t+1,                 &
540!                                 nest_offl%vg(t-nest_offl%tind,nzb+1:nzt) )
541!        ENDDO
542!
543!-- Read data at lateral and top boundaries. Please note, at left and right domain boundary,
544!-- yz-layers are read for u, v, w, pt and q.
545!-- For the v-component, the data starts at nysv, while for the other quantities the data starts at
546!-- nys. This is equivalent at the north and south domain boundary for the u-component (nxlu).
547!-- Note, lateral data is also accessed by parallel IO, which is the reason why different arguments
548!-- are passed depending on the boundary control flags. Cores that do not belong to the respective
549!-- boundary only do a dummy read with count = 0, just in order to participate the collective
550!-- operation. This is because collective parallel access shows better performance than just a
551!-- conditional access.
552!-- Read data for LOD 2, i.e. time-dependent xz-, yz-, and xy-slices.
553    IF ( lod == 2 )  THEN
554       CALL get_variable( pids_id, 'ls_forcing_left_u',                                            &
555                          nest_offl%u_l,                                                           & ! array to be read
556                          MERGE( nys+1, 1, bc_dirichlet_l),                                        & ! start index y direction
557                          MERGE( nzb+1, 1, bc_dirichlet_l),                                        & ! start index z direction
558                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                             & ! start index time dimension
559                          MERGE( nyn-nys+1, 0, bc_dirichlet_l),                                    & ! number of elements along y
560                          MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                                & ! number of elements alogn z
561                          MERGE( 2, 0, bc_dirichlet_l),                                            & ! number of time steps (2 or 0)
562                          .TRUE. )                                                                   ! parallel IO when compiled accordingly
563
564       CALL get_variable( pids_id, 'ls_forcing_left_v',                                            &
565                          nest_offl%v_l,                                                           &
566                          MERGE( nysv, 1, bc_dirichlet_l),                                         &
567                          MERGE( nzb+1, 1, bc_dirichlet_l),                                        &
568                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                             &
569                          MERGE( nyn-nysv+1, 0, bc_dirichlet_l),                                   &
570                          MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                                &
571                          MERGE( 2, 0, bc_dirichlet_l),                                            &
572                          .TRUE. )
573
574       CALL get_variable( pids_id, 'ls_forcing_left_w',                                            &
575                          nest_offl%w_l,                                                           &
576                          MERGE( nys+1, 1, bc_dirichlet_l),                                        &
577                          MERGE( nzb+1, 1, bc_dirichlet_l),                                        &
578                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                             &
579                          MERGE( nyn-nys+1, 0, bc_dirichlet_l),                                    &
580                          MERGE( nest_offl%nzw, 0, bc_dirichlet_l),                                &
581                          MERGE( 2, 0, bc_dirichlet_l),                                            &
582                          .TRUE. )
583
584       IF ( .NOT. neutral )  THEN
585          CALL get_variable( pids_id, 'ls_forcing_left_pt',                                        &
586                             nest_offl%pt_l,                                                       &
587                             MERGE( nys+1, 1, bc_dirichlet_l),                                     &
588                             MERGE( nzb+1, 1, bc_dirichlet_l),                                     &
589                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                          &
590                             MERGE( nyn-nys+1, 0, bc_dirichlet_l),                                 &
591                             MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                             &
592                             MERGE( 2, 0, bc_dirichlet_l),                                         &
593                             .TRUE. )
594       ENDIF
595
596       IF ( humidity )  THEN
597          CALL get_variable( pids_id, 'ls_forcing_left_qv',                                        &
598                             nest_offl%q_l,                                                        &
599                             MERGE( nys+1, 1, bc_dirichlet_l),                                     &
600                             MERGE( nzb+1, 1, bc_dirichlet_l),                                     &
601                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                          &
602                             MERGE( nyn-nys+1, 0, bc_dirichlet_l),                                 &
603                             MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                             &
604                             MERGE( 2, 0, bc_dirichlet_l),                                         &
605                             .TRUE. )
606       ENDIF
607
608       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
609          DO  n = 1, UBOUND( nest_offl%var_names_chem_l, 1 )
610             IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_l(n) ) )  THEN
611                CALL get_variable( pids_id,                                                        &
612                                   TRIM( nest_offl%var_names_chem_l(n) ),                          &
613                                   nest_offl%chem_l(:,:,:,n),                                      &
614                                   MERGE( nys+1, 1, bc_dirichlet_l),                               &
615                                   MERGE( nzb+1, 1, bc_dirichlet_l),                               &
616                                   MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                    &
617                                   MERGE( nyn-nys+1, 0, bc_dirichlet_l),                           &
618                                   MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                       &
619                                   MERGE( 2, 0, bc_dirichlet_l),                                   &
620                                   .TRUE. )
621                nest_offl%chem_from_file_l(n) = .TRUE.
622             ENDIF
623          ENDDO
624       ENDIF
625!
626!--    Read data for eastern boundary
627       CALL get_variable( pids_id, 'ls_forcing_right_u',                                           &
628                          nest_offl%u_r,                                                           &
629                          MERGE( nys+1, 1, bc_dirichlet_r),                                        &
630                          MERGE( nzb+1, 1, bc_dirichlet_r),                                        &
631                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                             &
632                          MERGE( nyn-nys+1, 0, bc_dirichlet_r),                                    &
633                          MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                                &
634                          MERGE( 2, 0, bc_dirichlet_r),                                            &
635                          .TRUE. )
636
637       CALL get_variable( pids_id, 'ls_forcing_right_v',                                           &
638                          nest_offl%v_r,                                                           &
639                          MERGE( nysv, 1, bc_dirichlet_r),                                         &
640                          MERGE( nzb+1, 1, bc_dirichlet_r),                                        &
641                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                             &
642                          MERGE( nyn-nysv+1, 0, bc_dirichlet_r),                                   &
643                          MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                                &
644                          MERGE( 2, 0, bc_dirichlet_r),                                            &
645                          .TRUE. )
646
647       CALL get_variable( pids_id, 'ls_forcing_right_w',                                           &
648                          nest_offl%w_r,                                                           &
649                          MERGE( nys+1, 1, bc_dirichlet_r),                                        &
650                          MERGE( nzb+1, 1, bc_dirichlet_r),                                        &
651                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                             &
652                          MERGE( nyn-nys+1, 0, bc_dirichlet_r),                                    &
653                          MERGE( nest_offl%nzw, 0, bc_dirichlet_r),                                &
654                          MERGE( 2, 0, bc_dirichlet_r),                                            &
655                          .TRUE. )
656
657       IF ( .NOT. neutral )  THEN
658          CALL get_variable( pids_id, 'ls_forcing_right_pt',                                       &
659                             nest_offl%pt_r,                                                       &
660                             MERGE( nys+1, 1, bc_dirichlet_r),                                     &
661                             MERGE( nzb+1, 1, bc_dirichlet_r),                                     &
662                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                          &
663                             MERGE( nyn-nys+1, 0, bc_dirichlet_r),                                 &
664                             MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                             &
665                             MERGE( 2, 0, bc_dirichlet_r),                                         &
666                             .TRUE. )
667       ENDIF
668
669       IF ( humidity )  THEN
670          CALL get_variable( pids_id, 'ls_forcing_right_qv',                                       &
671                             nest_offl%q_r,                                                        &
672                             MERGE( nys+1, 1, bc_dirichlet_r),                                     &
673                             MERGE( nzb+1, 1, bc_dirichlet_r),                                     &
674                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                          &
675                             MERGE( nyn-nys+1, 0, bc_dirichlet_r),                                 &
676                             MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                             &
677                             MERGE( 2, 0, bc_dirichlet_r),                                         &
678                             .TRUE. )
679       ENDIF
680
681       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
682          DO  n = 1, UBOUND( nest_offl%var_names_chem_r, 1 )
683             IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_r(n) ) )  THEN
684                CALL get_variable( pids_id,                                                        &
685                                   TRIM( nest_offl%var_names_chem_r(n) ),                          &
686                                   nest_offl%chem_r(:,:,:,n),                                      &
687                                   MERGE( nys+1, 1, bc_dirichlet_r),                               &
688                                   MERGE( nzb+1, 1, bc_dirichlet_r),                               &
689                                   MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                    &
690                                   MERGE( nyn-nys+1, 0, bc_dirichlet_r),                           &
691                                   MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                       &
692                                   MERGE( 2, 0, bc_dirichlet_r),                                   &
693                                   .TRUE. )
694                nest_offl%chem_from_file_r(n) = .TRUE.
695             ENDIF
696          ENDDO
697       ENDIF
698!
699!--    Read data for northern boundary
700       CALL get_variable( pids_id, 'ls_forcing_north_u',                                           &
701                          nest_offl%u_n,                                                           &
702                          MERGE( nxlu, 1, bc_dirichlet_n ),                                        &
703                          MERGE( nzb+1, 1, bc_dirichlet_n ),                                       &
704                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),                            &
705                          MERGE( nxr-nxlu+1, 0, bc_dirichlet_n ),                                  &
706                          MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),                               &
707                          MERGE( 2, 0, bc_dirichlet_n ),                                           &
708                          .TRUE. )
709
710       CALL get_variable( pids_id, 'ls_forcing_north_v',                                           &
711                          nest_offl%v_n,                                                           &
712                          MERGE( nxl+1, 1, bc_dirichlet_n ),                                       &
713                          MERGE( nzb+1, 1, bc_dirichlet_n ),                                       &
714                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),                            &
715                          MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),                                   &
716                          MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),                               &
717                          MERGE( 2, 0, bc_dirichlet_n ),                                           &
718                          .TRUE. )
719
720       CALL get_variable( pids_id, 'ls_forcing_north_w',                                           &
721                          nest_offl%w_n,                                                           &
722                          MERGE( nxl+1, 1, bc_dirichlet_n ),                                       &
723                          MERGE( nzb+1, 1, bc_dirichlet_n ),                                       &
724                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),                            &
725                          MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),                                   &
726                          MERGE( nest_offl%nzw, 0, bc_dirichlet_n ),                               &
727                          MERGE( 2, 0, bc_dirichlet_n ),                                           &
728                          .TRUE. )
729
730       IF ( .NOT. neutral )  THEN
731          CALL get_variable( pids_id, 'ls_forcing_north_pt',                                       &
732                             nest_offl%pt_n,                                                       &
733                             MERGE( nxl+1, 1, bc_dirichlet_n ),                                    &
734                             MERGE( nzb+1, 1, bc_dirichlet_n ),                                    &
735                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),                         &
736                             MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),                                &
737                             MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),                            &
738                             MERGE( 2, 0, bc_dirichlet_n ),                                        &
739                             .TRUE. )
740       ENDIF
741       IF ( humidity )  THEN
742          CALL get_variable( pids_id, 'ls_forcing_north_qv',                                       &
743                             nest_offl%q_n,                                                        &
744                             MERGE( nxl+1, 1, bc_dirichlet_n ),                                    &
745                             MERGE( nzb+1, 1, bc_dirichlet_n ),                                    &
746                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),                         &
747                             MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),                                &
748                             MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),                            &
749                             MERGE( 2, 0, bc_dirichlet_n ),                                        &
750                             .TRUE. )
751       ENDIF
752
753       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
754          DO  n = 1, UBOUND( nest_offl%var_names_chem_n, 1 )
755             IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_n(n) ) )  THEN
756                CALL get_variable( pids_id,                                                        &
757                                   TRIM( nest_offl%var_names_chem_n(n) ),                          &
758                                   nest_offl%chem_n(:,:,:,n),                                      &
759                                   MERGE( nxl+1, 1, bc_dirichlet_n ),                              &
760                                   MERGE( nzb+1, 1, bc_dirichlet_n ),                              &
761                                   MERGE( nest_offl%tind+1, 1, bc_dirichlet_n ),                   &
762                                   MERGE( nxr-nxl+1, 0, bc_dirichlet_n ),                          &
763                                   MERGE( nest_offl%nzu, 0, bc_dirichlet_n ),                      &
764                                   MERGE( 2, 0, bc_dirichlet_n ),                                  &
765                                   .TRUE. )
766                nest_offl%chem_from_file_n(n) = .TRUE.
767             ENDIF
768          ENDDO
769       ENDIF
770!
771!--    Read data for southern boundary
772       CALL get_variable( pids_id, 'ls_forcing_south_u',                                           &
773                          nest_offl%u_s,                                                           &
774                          MERGE( nxlu, 1, bc_dirichlet_s ),                                        &
775                          MERGE( nzb+1, 1, bc_dirichlet_s ),                                       &
776                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),                            &
777                          MERGE( nxr-nxlu+1, 0, bc_dirichlet_s ),                                  &
778                          MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),                               &
779                          MERGE( 2, 0, bc_dirichlet_s ),                                           &
780                          .TRUE. )
781
782       CALL get_variable( pids_id, 'ls_forcing_south_v',                                           &
783                          nest_offl%v_s,                                                           &
784                          MERGE( nxl+1, 1, bc_dirichlet_s ),                                       &
785                          MERGE( nzb+1, 1, bc_dirichlet_s ),                                       &
786                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),                            &
787                          MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),                                   &
788                          MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),                               &
789                          MERGE( 2, 0, bc_dirichlet_s ),                                           &
790                          .TRUE. )
791
792       CALL get_variable( pids_id, 'ls_forcing_south_w',                                           &
793                          nest_offl%w_s,                                                           &
794                          MERGE( nxl+1, 1, bc_dirichlet_s ),                                       &
795                          MERGE( nzb+1, 1, bc_dirichlet_s ),                                       &
796                          MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),                            &
797                          MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),                                   &
798                          MERGE( nest_offl%nzw, 0, bc_dirichlet_s ),                               &
799                          MERGE( 2, 0, bc_dirichlet_s ),                                           &
800                          .TRUE. )
801
802       IF ( .NOT. neutral )  THEN
803          CALL get_variable( pids_id, 'ls_forcing_south_pt',                                       &
804                             nest_offl%pt_s,                                                       &
805                             MERGE( nxl+1, 1, bc_dirichlet_s ),                                    &
806                             MERGE( nzb+1, 1, bc_dirichlet_s ),                                    &
807                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),                         &
808                             MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),                                &
809                             MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),                            &
810                             MERGE( 2, 0, bc_dirichlet_s ),                                        &
811                             .TRUE. )
812       ENDIF
813       IF ( humidity )  THEN
814          CALL get_variable( pids_id, 'ls_forcing_south_qv',                                       &
815                             nest_offl%q_s,                                                        &
816                             MERGE( nxl+1, 1, bc_dirichlet_s ),                                    &
817                             MERGE( nzb+1, 1, bc_dirichlet_s ),                                    &
818                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),                         &
819                             MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),                                &
820                             MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),                            &
821                             MERGE( 2, 0, bc_dirichlet_s ),                                        &
822                             .TRUE. )
823       ENDIF
824
825       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
826          DO  n = 1, UBOUND( nest_offl%var_names_chem_s, 1 )
827             IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_s(n) ) )  THEN
828                CALL get_variable( pids_id,                                                        &
829                                   TRIM( nest_offl%var_names_chem_s(n) ),                          &
830                                   nest_offl%chem_s(:,:,:,n),                                      &
831                                   MERGE( nxl+1, 1, bc_dirichlet_s ),                              &
832                                   MERGE( nzb+1, 1, bc_dirichlet_s ),                              &
833                                   MERGE( nest_offl%tind+1, 1, bc_dirichlet_s ),                   &
834                                   MERGE( nxr-nxl+1, 0, bc_dirichlet_s ),                          &
835                                   MERGE( nest_offl%nzu, 0, bc_dirichlet_s ),                      &
836                                   MERGE( 2, 0, bc_dirichlet_s ),                                  &
837                                   .TRUE. )
838                nest_offl%chem_from_file_s(n) = .TRUE.
839             ENDIF
840          ENDDO
841       ENDIF
842!
843!--    Top boundary
844       CALL get_variable( pids_id, 'ls_forcing_top_u',                                             &
845                          nest_offl%u_top(0:1,nys:nyn,nxlu:nxr),                                   &
846                          nxlu, nys+1, nest_offl%tind+1,                                           &
847                          nxr-nxlu+1, nyn-nys+1, 2, .TRUE. )
848
849       CALL get_variable( pids_id, 'ls_forcing_top_v',                                             &
850                          nest_offl%v_top(0:1,nysv:nyn,nxl:nxr),                                   &
851                          nxl+1, nysv, nest_offl%tind+1,                                           &
852                          nxr-nxl+1, nyn-nysv+1, 2, .TRUE. )
853
854       CALL get_variable( pids_id, 'ls_forcing_top_w',                                             &
855                          nest_offl%w_top(0:1,nys:nyn,nxl:nxr),                                    &
856                          nxl+1, nys+1, nest_offl%tind+1,                                          &
857                          nxr-nxl+1, nyn-nys+1, 2, .TRUE. )
858
859       IF ( .NOT. neutral )  THEN
860          CALL get_variable( pids_id, 'ls_forcing_top_pt',                                         &
861                             nest_offl%pt_top(0:1,nys:nyn,nxl:nxr),                                &
862                             nxl+1, nys+1, nest_offl%tind+1,                                       &
863                             nxr-nxl+1, nyn-nys+1, 2, .TRUE. )
864       ENDIF
865       IF ( humidity )  THEN
866          CALL get_variable( pids_id, 'ls_forcing_top_qv',                                         &
867                             nest_offl%q_top(0:1,nys:nyn,nxl:nxr),                                 &
868                             nxl+1, nys+1, nest_offl%tind+1,                                       &
869                             nxr-nxl+1, nyn-nys+1, 2, .TRUE. )
870       ENDIF
871
872       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
873          DO  n = 1, UBOUND( nest_offl%var_names_chem_t, 1 )
874             IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_t(n) ) )  THEN
875                CALL get_variable( pids_id,                                                        &
876                                   TRIM( nest_offl%var_names_chem_t(n) ),                          &
877                                   nest_offl%chem_top(0:1,nys:nyn,nxl:nxr,n),                      &
878                                   nxl+1, nys+1, nest_offl%tind+1,                                 &
879                                   nxr-nxl+1, nyn-nys+1, 2, .TRUE. )
880                nest_offl%chem_from_file_t(n) = .TRUE.
881             ENDIF
882          ENDDO
883       ENDIF
884!
885!-- Read data for LOD 1, i.e. time-dependent profiles. In constrast to LOD 2 where the amount of IO
886!-- is larger, only the respective boundary processes read the data.
887    ELSE
888       IF ( bc_dirichlet_l )  THEN
889          CALL get_variable( pids_id, 'ls_forcing_left_u',                                         &
890                             nest_offl%u_l(0:1,:,1:1),                                             & ! array to be read
891                             MERGE( nzb+1, 1, bc_dirichlet_l),                                     & ! start index z direction
892                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                          & ! start index time dimension
893                             MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                             & ! number of elements along z
894                             MERGE( 2, 0, bc_dirichlet_l) )                                          ! number of time steps (2 or 0)
895          CALL get_variable( pids_id, 'ls_forcing_left_v',                                         &
896                             nest_offl%v_l(0:1,:,1:1),                                             &
897                             MERGE( nzb+1, 1, bc_dirichlet_l),                                     &
898                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                          &
899                             MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                             &
900                             MERGE( 2, 0, bc_dirichlet_l) )
901          CALL get_variable( pids_id, 'ls_forcing_left_w',                                         &
902                             nest_offl%w_l(0:1,:,1:1),                                             &
903                             MERGE( nzb+1, 1, bc_dirichlet_l),                                     &
904                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                          &
905                             MERGE( nest_offl%nzw, 0, bc_dirichlet_l),                             &
906                             MERGE( 2, 0, bc_dirichlet_l) )
907          IF ( .NOT. neutral )  THEN
908             CALL get_variable( pids_id, 'ls_forcing_left_pt',                                     &
909                                nest_offl%pt_l(0:1,:,1:1),                                         &
910                                MERGE( nzb+1, 1, bc_dirichlet_l),                                  &
911                                MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                       &
912                                MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                          &
913                                MERGE( 2, 0, bc_dirichlet_l) )
914          ENDIF
915          IF ( humidity )  THEN
916             CALL get_variable( pids_id, 'ls_forcing_left_qv',                                     &
917                                nest_offl%q_l(0:1,:,1:1),                                          &
918                                MERGE( nzb+1, 1, bc_dirichlet_l),                                  &
919                                MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                       &
920                                MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                          &
921                                MERGE( 2, 0, bc_dirichlet_l) )
922          ENDIF
923          IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
924             DO  n = 1, UBOUND( nest_offl%var_names_chem_t, 1 )
925                IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_t(n) ) )  THEN
926                   CALL get_variable( pids_id, TRIM( nest_offl%var_names_chem_t(n) ),              &
927                                      nest_offl%chem_l(0:1,:,1:1,n),                               &
928                                      MERGE( nzb+1, 1, bc_dirichlet_l),                            &
929                                      MERGE( nest_offl%tind+1, 1, bc_dirichlet_l),                 &
930                                      MERGE( nest_offl%nzu, 0, bc_dirichlet_l),                    &
931                                      MERGE( 2, 0, bc_dirichlet_l) )
932                   nest_offl%chem_from_file_l(n) = .TRUE.
933                ENDIF
934             ENDDO
935          ENDIF
936       ENDIF
937       IF ( bc_dirichlet_r )  THEN
938          CALL get_variable( pids_id, 'ls_forcing_right_u',                                        &
939                             nest_offl%u_r(0:1,:,1:1),                                             &
940                             MERGE( nzb+1, 1, bc_dirichlet_r),                                     &
941                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                          &
942                             MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                             &
943                             MERGE( 2, 0, bc_dirichlet_r) )
944          CALL get_variable( pids_id, 'ls_forcing_right_v',                                        &
945                             nest_offl%v_r(0:1,:,1:1),                                             &
946                             MERGE( nzb+1, 1, bc_dirichlet_r),                                     &
947                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                          &
948                             MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                             &
949                             MERGE( 2, 0, bc_dirichlet_r) )
950          CALL get_variable( pids_id, 'ls_forcing_right_w',                                        &
951                             nest_offl%w_r(0:1,:,1:1),                                             &
952                             MERGE( nzb+1, 1, bc_dirichlet_r),                                     &
953                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                          &
954                             MERGE( nest_offl%nzw, 0, bc_dirichlet_r),                             &
955                             MERGE( 2, 0, bc_dirichlet_r) )
956          IF ( .NOT. neutral )  THEN
957             CALL get_variable( pids_id, 'ls_forcing_right_pt',                                    &
958                                nest_offl%pt_r(0:1,:,1:1),                                         &
959                                MERGE( nzb+1, 1, bc_dirichlet_r),                                  &
960                                MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                       &
961                                MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                          &
962                                MERGE( 2, 0, bc_dirichlet_r) )
963          ENDIF
964          IF ( humidity )  THEN
965             CALL get_variable( pids_id, 'ls_forcing_right_qv',                                    &
966                                nest_offl%q_r(0:1,:,1:1),                                          &
967                                MERGE( nzb+1, 1, bc_dirichlet_r),                                  &
968                                MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                       &
969                                MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                          &
970                                MERGE( 2, 0, bc_dirichlet_r) )
971          ENDIF
972          IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
973             DO  n = 1, UBOUND( nest_offl%var_names_chem_t, 1 )
974                IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_t(n) ) )  THEN
975                   CALL get_variable( pids_id, TRIM( nest_offl%var_names_chem_t(n) ),              &
976                                      nest_offl%chem_r(0:1,:,1:1,n),                               &
977                                      MERGE( nzb+1, 1, bc_dirichlet_r),                            &
978                                      MERGE( nest_offl%tind+1, 1, bc_dirichlet_r),                 &
979                                      MERGE( nest_offl%nzu, 0, bc_dirichlet_r),                    &
980                                      MERGE( 2, 0, bc_dirichlet_r) )
981                   nest_offl%chem_from_file_r(n) = .TRUE.
982                ENDIF
983             ENDDO
984          ENDIF
985       ENDIF
986       IF ( bc_dirichlet_n )  THEN
987          CALL get_variable( pids_id, 'ls_forcing_north_u',                                        &
988                             nest_offl%u_n(0:1,:,1:1),                                             &
989                             MERGE( nzb+1, 1, bc_dirichlet_n),                                     &
990                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_n),                          &
991                             MERGE( nest_offl%nzu, 0, bc_dirichlet_n),                             &
992                             MERGE( 2, 0, bc_dirichlet_n) )
993          CALL get_variable( pids_id, 'ls_forcing_north_v',                                        &
994                             nest_offl%v_n(0:1,:,1:1),                                             &
995                             MERGE( nzb+1, 1, bc_dirichlet_n),                                     &
996                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_n),                          &
997                             MERGE( nest_offl%nzu, 0, bc_dirichlet_n),                             &
998                             MERGE( 2, 0, bc_dirichlet_n) )
999          CALL get_variable( pids_id, 'ls_forcing_north_w',                                        &
1000                             nest_offl%w_n(0:1,:,1:1),                                             &
1001                             MERGE( nzb+1, 1, bc_dirichlet_n),                                     &
1002                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_n),                          &
1003                             MERGE( nest_offl%nzw, 0, bc_dirichlet_n),                             &
1004                             MERGE( 2, 0, bc_dirichlet_n) )
1005          IF ( .NOT. neutral )  THEN
1006             CALL get_variable( pids_id, 'ls_forcing_north_pt',                                    &
1007                                nest_offl%pt_n(0:1,:,1:1),                                         &
1008                                MERGE( nzb+1, 1, bc_dirichlet_n),                                  &
1009                                MERGE( nest_offl%tind+1, 1, bc_dirichlet_n),                       &
1010                                MERGE( nest_offl%nzu, 0, bc_dirichlet_n),                          &
1011                                MERGE( 2, 0, bc_dirichlet_n) )
1012          ENDIF
1013          IF ( humidity )  THEN
1014             CALL get_variable( pids_id, 'ls_forcing_north_qv',                                    &
1015                                nest_offl%q_n(0:1,:,1:1),                                          &
1016                                MERGE( nzb+1, 1, bc_dirichlet_n),                                  &
1017                                MERGE( nest_offl%tind+1, 1, bc_dirichlet_n),                       &
1018                                MERGE( nest_offl%nzu, 0, bc_dirichlet_n),                          &
1019                                MERGE( 2, 0, bc_dirichlet_n) )
1020          ENDIF
1021          IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
1022             DO  n = 1, UBOUND( nest_offl%var_names_chem_t, 1 )
1023                IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_t(n) ) )  THEN
1024                   CALL get_variable( pids_id, TRIM( nest_offl%var_names_chem_t(n) ),              &
1025                                      nest_offl%chem_n(0:1,:,1:1,n),                               &
1026                                      MERGE( nzb+1, 1, bc_dirichlet_n),                            &
1027                                      MERGE( nest_offl%tind+1, 1, bc_dirichlet_n),                 &
1028                                      MERGE( nest_offl%nzu, 0, bc_dirichlet_n),                    &
1029                                      MERGE( 2, 0, bc_dirichlet_n) )
1030                   nest_offl%chem_from_file_n(n) = .TRUE.
1031                ENDIF
1032             ENDDO
1033          ENDIF
1034       ENDIF
1035       IF ( bc_dirichlet_s )  THEN
1036          CALL get_variable( pids_id, 'ls_forcing_south_u',                                        &
1037                             nest_offl%u_s(0:1,:,1:1),                                             &
1038                             MERGE( nzb+1, 1, bc_dirichlet_s),                                     &
1039                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_s),                          &
1040                             MERGE( nest_offl%nzu, 0, bc_dirichlet_s),                             &
1041                             MERGE( 2, 0, bc_dirichlet_s) )
1042          CALL get_variable( pids_id, 'ls_forcing_south_v',                                        &
1043                             nest_offl%v_s(0:1,:,1:1),                                             &
1044                             MERGE( nzb+1, 1, bc_dirichlet_s),                                     &
1045                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_s),                          &
1046                             MERGE( nest_offl%nzu, 0, bc_dirichlet_s),                             &
1047                             MERGE( 2, 0, bc_dirichlet_s) )
1048          CALL get_variable( pids_id, 'ls_forcing_south_w',                                        &
1049                             nest_offl%w_s(0:1,:,1:1),                                             &
1050                             MERGE( nzb+1, 1, bc_dirichlet_s),                                     &
1051                             MERGE( nest_offl%tind+1, 1, bc_dirichlet_s),                          &
1052                             MERGE( nest_offl%nzw, 0, bc_dirichlet_s),                             &
1053                             MERGE( 2, 0, bc_dirichlet_s) )
1054          IF ( .NOT. neutral )  THEN
1055             CALL get_variable( pids_id, 'ls_forcing_south_pt',                                    &
1056                                nest_offl%pt_s(0:1,:,1:1),                                         &
1057                                MERGE( nzb+1, 1, bc_dirichlet_s),                                  &
1058                                MERGE( nest_offl%tind+1, 1, bc_dirichlet_s),                       &
1059                                MERGE( nest_offl%nzu, 0, bc_dirichlet_s),                          &
1060                                MERGE( 2, 0, bc_dirichlet_s) )
1061          ENDIF
1062          IF ( humidity )  THEN
1063             CALL get_variable( pids_id, 'ls_forcing_south_qv',                                    &
1064                                nest_offl%q_s(0:1,:,1:1),                                          &
1065                                MERGE( nzb+1, 1, bc_dirichlet_s),                                  &
1066                                MERGE( nest_offl%tind+1, 1, bc_dirichlet_s),                       &
1067                                MERGE( nest_offl%nzu, 0, bc_dirichlet_s),                          &
1068                                MERGE( 2, 0, bc_dirichlet_s) )
1069          ENDIF
1070          IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
1071             DO  n = 1, UBOUND( nest_offl%var_names_chem_t, 1 )
1072                IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_t(n) ) )  THEN
1073                   CALL get_variable( pids_id, TRIM( nest_offl%var_names_chem_t(n) ),              &
1074                                      nest_offl%chem_s(0:1,:,1:1,n),                               &
1075                                      MERGE( nzb+1, 1, bc_dirichlet_s),                            &
1076                                      MERGE( nest_offl%tind+1, 1, bc_dirichlet_s),                 &
1077                                      MERGE( nest_offl%nzu, 0, bc_dirichlet_s),                    &
1078                                      MERGE( 2, 0, bc_dirichlet_s) )
1079                   nest_offl%chem_from_file_s(n) = .TRUE.
1080                ENDIF
1081             ENDDO
1082          ENDIF
1083       ENDIF
1084!
1085!--    Read top boundary data, which is actually only a scalar value in the LOD 1 case.
1086       CALL get_variable( pids_id, 'ls_forcing_top_u',                                             &
1087                          nest_offl%u_top(0:1,1,1),                                                & ! array to be read
1088                          nest_offl%tind+1,                                                        & ! start index in time
1089                          2 )                                                                        ! number of elements to be read
1090       CALL get_variable( pids_id, 'ls_forcing_top_v',                                             &
1091                          nest_offl%v_top(0:1,1,1),                                                &
1092                          nest_offl%tind+1,                                                        &
1093                          2 )
1094       CALL get_variable( pids_id, 'ls_forcing_top_w',                                             &
1095                          nest_offl%w_top(0:1,1,1),                                                &
1096                          nest_offl%tind+1,                                                        &
1097                          2 )
1098       IF ( .NOT. neutral )  THEN
1099          CALL get_variable( pids_id, 'ls_forcing_top_pt',                                         &
1100                             nest_offl%pt_top(0:1,1,1),                                            &
1101                             nest_offl%tind+1,                                                     &
1102                             2 )
1103       ENDIF
1104       IF ( humidity )  THEN
1105          CALL get_variable( pids_id, 'ls_forcing_top_qv',                                         &
1106                             nest_offl%q_top(0:1,1,1),                                             &
1107                             nest_offl%tind+1,                                                     &
1108                             2 )
1109       ENDIF
1110       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
1111          DO  n = 1, UBOUND( nest_offl%var_names_chem_t, 1 )
1112             IF ( check_existence( nest_offl%var_names, nest_offl%var_names_chem_t(n) ) )  THEN
1113                CALL get_variable( pids_id, TRIM( nest_offl%var_names_chem_t(n) ),                 &
1114                                   nest_offl%chem_top(0:1,1,1,n),                                  &
1115                                   nest_offl%tind+1,                                               &
1116                                   2 )
1117                nest_offl%chem_from_file_t(n) = .TRUE.
1118             ENDIF
1119          ENDDO
1120       ENDIF
1121    ENDIF
1122
1123
1124!
1125!-- Close input file
1126    CALL close_input_file( pids_id )
1127#endif
1128!
1129!-- Set control flag to indicate that boundary data has been initially input.
1130    nest_offl%init = .TRUE.
1131!
1132!-- Call offline nesting for salsa
1133    IF ( salsa )  CALL salsa_nesting_offl_input
1134!
1135!-- End of CPU measurement
1136    CALL cpu_log( log_point_s(86), 'NetCDF input forcing', 'stop' )
1137
1138 END SUBROUTINE nesting_offl_input
1139
1140
1141!--------------------------------------------------------------------------------------------------!
1142! Description:
1143! ------------
1144!> In this subroutine a constant mass within the model domain is guaranteed.
1145!> Larger-scale models may be based on a compressible equation system, which is not consistent with
1146!> PALMs incompressible equation system. In order to avoid a decrease or increase of mass during the
1147!> simulation, non-divergent flow through the lateral and top boundaries is compensated by the
1148!> vertical wind component at the top boundary.
1149!--------------------------------------------------------------------------------------------------!
1150 SUBROUTINE nesting_offl_mass_conservation
1151
1152    INTEGER(iwp) ::  i  !< grid index in x-direction
1153    INTEGER(iwp) ::  j  !< grid index in y-direction
1154    INTEGER(iwp) ::  k  !< grid index in z-direction
1155
1156    REAL(wp) ::  d_area_t   !< inverse of the total area of the horizontal model domain
1157    REAL(wp) ::  w_correct  !< vertical velocity increment required to compensate non-divergent flow through the boundaries
1158
1159    REAL(wp), DIMENSION(1:3) ::  volume_flow_l   !< local volume flow
1160
1161
1162    IF ( debug_output_timestep )  CALL debug_message( 'nesting_offl_mass_conservation', 'start' )
1163
1164    CALL  cpu_log( log_point(58), 'offline nesting', 'start' )
1165
1166    volume_flow   = 0.0_wp
1167    volume_flow_l = 0.0_wp
1168
1169    d_area_t = 1.0_wp / ( ( nx + 1 ) * dx * ( ny + 1 ) * dy )
1170
1171    IF ( bc_dirichlet_l )  THEN
1172       i = nxl
1173       DO  j = nys, nyn
1174          DO  k = nzb+1, nzt
1175             volume_flow_l(1) = volume_flow_l(1) + u(k,j,i) * dzw(k) * dy * rho_air(k)             &
1176                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
1177          ENDDO
1178       ENDDO
1179    ENDIF
1180    IF ( bc_dirichlet_r )  THEN
1181       i = nxr+1
1182       DO  j = nys, nyn
1183          DO  k = nzb+1, nzt
1184             volume_flow_l(1) = volume_flow_l(1) - u(k,j,i) * dzw(k) * dy * rho_air(k)             &
1185                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
1186          ENDDO
1187       ENDDO
1188    ENDIF
1189    IF ( bc_dirichlet_s )  THEN
1190       j = nys
1191       DO  i = nxl, nxr
1192          DO  k = nzb+1, nzt
1193             volume_flow_l(2) = volume_flow_l(2) + v(k,j,i) * dzw(k) * dx * rho_air(k)             &
1194                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
1195          ENDDO
1196       ENDDO
1197    ENDIF
1198    IF ( bc_dirichlet_n )  THEN
1199       j = nyn+1
1200       DO  i = nxl, nxr
1201          DO  k = nzb+1, nzt
1202             volume_flow_l(2) = volume_flow_l(2) - v(k,j,i) * dzw(k) * dx * rho_air(k)             &
1203                                * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
1204          ENDDO
1205       ENDDO
1206    ENDIF
1207!
1208!-- Top boundary
1209    k = nzt
1210    DO  i = nxl, nxr
1211       DO  j = nys, nyn
1212          volume_flow_l(3) = volume_flow_l(3) - rho_air_zw(k) * w(k,j,i) * dx * dy
1213       ENDDO
1214    ENDDO
1215
1216#if defined( __parallel )
1217    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
1218    CALL MPI_ALLREDUCE( volume_flow_l, volume_flow, 3, MPI_REAL, MPI_SUM, comm2d, ierr )
1219#else
1220    volume_flow = volume_flow_l
1221#endif
1222
1223    w_correct = SUM( volume_flow ) * d_area_t * drho_air_zw(nzt)
1224
1225    DO  i = nxl, nxr
1226       DO  j = nys, nyn
1227          DO  k = nzt, nzt + 1
1228             w(k,j,i) = w(k,j,i) + w_correct                                                       &
1229                                   * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
1230          ENDDO
1231       ENDDO
1232    ENDDO
1233
1234    CALL  cpu_log( log_point(58), 'offline nesting', 'stop' )
1235
1236    IF ( debug_output_timestep )  CALL debug_message( 'nesting_offl_mass_conservation', 'end' )
1237
1238 END SUBROUTINE nesting_offl_mass_conservation
1239
1240
1241!--------------------------------------------------------------------------------------------------!
1242! Description:
1243! ------------
1244!> Set the lateral and top boundary conditions in case the PALM domain is nested offline in a
1245!> mesoscale model. Further, average boundary data and determine mean profiles, further used for
1246!> correct damping in the sponge layer.
1247!--------------------------------------------------------------------------------------------------!
1248 SUBROUTINE nesting_offl_bc
1249
1250    USE exchange_horiz_mod,                                                                        &
1251        ONLY:  exchange_horiz
1252
1253    INTEGER(iwp) ::  i  !< running index x-direction
1254    INTEGER(iwp) ::  j  !< running index y-direction
1255    INTEGER(iwp) ::  k  !< running index z-direction
1256    INTEGER(iwp) ::  n  !< running index for chemical species
1257
1258    REAL(wp), DIMENSION(nzb:nzt+1) ::  pt_ref    !< reference profile for potential temperature
1259    REAL(wp), DIMENSION(nzb:nzt+1) ::  pt_ref_l  !< reference profile for potential temperature on subdomain
1260    REAL(wp), DIMENSION(nzb:nzt+1) ::  q_ref     !< reference profile for mixing ratio
1261    REAL(wp), DIMENSION(nzb:nzt+1) ::  q_ref_l   !< reference profile for mixing ratio on subdomain
1262    REAL(wp), DIMENSION(nzb:nzt+1) ::  u_ref     !< reference profile for u-component
1263    REAL(wp), DIMENSION(nzb:nzt+1) ::  u_ref_l   !< reference profile for u-component on subdomain
1264    REAL(wp), DIMENSION(nzb:nzt+1) ::  v_ref     !< reference profile for v-component
1265    REAL(wp), DIMENSION(nzb:nzt+1) ::  v_ref_l   !< reference profile for v-component on subdomain
1266    REAL(wp), DIMENSION(nzb:nzt+1) ::  var_1d    !< pre-interpolated profile for LOD1 mode
1267
1268    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_chem    !< reference profile for chemical species
1269    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ref_chem_l  !< reference profile for chemical species on subdomain
1270
1271    IF ( debug_output_timestep )  CALL debug_message( 'nesting_offl_bc', 'start' )
1272
1273    CALL  cpu_log( log_point(58), 'offline nesting', 'start' )
1274!
1275!-- Initialize mean profiles, derived from boundary data, to zero.
1276    pt_ref   = 0.0_wp
1277    q_ref    = 0.0_wp
1278    u_ref    = 0.0_wp
1279    v_ref    = 0.0_wp
1280
1281    pt_ref_l = 0.0_wp
1282    q_ref_l  = 0.0_wp
1283    u_ref_l  = 0.0_wp
1284    v_ref_l  = 0.0_wp
1285!
1286!-- If required, allocate temporary arrays to compute chemistry mean profiles
1287    IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
1288       ALLOCATE( ref_chem(nzb:nzt+1,1:UBOUND( chem_species, 1 ) )   )
1289       ALLOCATE( ref_chem_l(nzb:nzt+1,1:UBOUND( chem_species, 1 ) ) )
1290       ref_chem   = 0.0_wp
1291       ref_chem_l = 0.0_wp
1292    ENDIF
1293!
1294!-- Set boundary conditions of u-, v-, w-component, as well as q, and pt.
1295!-- Note, boundary values at the left boundary: i=-1 (v,w,pt,q) and i=0 (u), at the right boundary:
1296!-- i=nxr+1 (all), at the south boundary: j=-1 (u,w,pt,q) and j=0 (v), at the north boundary:
1297!-- j=nyn+1 (all).
1298!-- Please note, at the left (for u) and south (for v) boundary, values for u and v are set also at
1299!-- i/j=-1, since these values are used in boundary_conditions() to restore prognostic values.
1300!-- Further, sum up data to calculate mean profiles from boundary data, used for Rayleigh damping.
1301    IF ( bc_dirichlet_l  )  THEN
1302!
1303!--    u-component
1304       IF ( lod == 2 )  THEN
1305          DO  j = nys, nyn
1306             DO  k = nzb+1, nzt
1307                u(k,j,i_bound_u) = interpolate_in_time( nest_offl%u_l(0,k,j),                      &
1308                                                        nest_offl%u_l(1,k,j),                      &
1309                                                        fac_dt ) *                                 &
1310                                   MERGE( 1.0_wp, 0.0_wp,                                          &
1311                                          BTEST( wall_flags_total_0(k,j,i_bound_u), 1 ) )
1312             ENDDO
1313             u(:,j,i_bound_u-1) = u(:,j,i_bound_u)
1314             u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j,i_bound_u)
1315          ENDDO
1316       ELSE
1317!
1318!--       Pre-interpolate profile before mapping onto the boundaries.
1319          DO  k = nzb+1, nzt
1320             var_1d(k) = interpolate_in_time( nest_offl%u_l(0,k,1),                                &
1321                                              nest_offl%u_l(1,k,1),                                &
1322                                              fac_dt )
1323          ENDDO
1324          DO  j = nys, nyn
1325             u(nzb+1:nzt,j,i_bound_u) = var_1d(nzb+1:nzt) *                                        &
1326                                     MERGE( 1.0_wp, 0.0_wp,                                        &
1327                                            BTEST( wall_flags_total_0(nzb+1:nzt,j,i_bound_u), 1 ) )
1328             u(:,j,i_bound_u-1) = u(:,j,i_bound_u)
1329             u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j,i_bound_u)
1330          ENDDO
1331       ENDIF
1332!
1333!--    w-component
1334       IF ( lod == 2 )  THEN
1335          DO  j = nys, nyn
1336             DO  k = nzb+1, nzt-1
1337                w(k,j,i_bound) = interpolate_in_time( nest_offl%w_l(0,k,j),                        &
1338                                                      nest_offl%w_l(1,k,j),                        &
1339                                                      fac_dt ) *                                   &
1340                                 MERGE( 1.0_wp, 0.0_wp,                                            &
1341                                        BTEST( wall_flags_total_0(k,j,i_bound), 3 ) )
1342             ENDDO
1343             w(nzt,j,i_bound) = w(nzt-1,j,i_bound)
1344          ENDDO
1345       ELSE
1346          DO  k = nzb+1, nzt-1
1347             var_1d(k) = interpolate_in_time( nest_offl%w_l(0,k,1),                                &
1348                                              nest_offl%w_l(1,k,1),                                &
1349                                              fac_dt )
1350          ENDDO
1351          DO  j = nys, nyn
1352             w(nzb+1:nzt-1,j,i_bound) = var_1d(nzb+1:nzt-1) *                                      &
1353                                      MERGE( 1.0_wp, 0.0_wp,                                       &
1354                                             BTEST( wall_flags_total_0(nzb+1:nzt-1,j,i_bound), 3 ) )
1355             w(nzt,j,i_bound) = w(nzt-1,j,i_bound)
1356          ENDDO
1357       ENDIF
1358!
1359!--    v-component
1360       IF ( lod == 2 )  THEN
1361          DO  j = nysv, nyn
1362             DO  k = nzb+1, nzt
1363                v(k,j,i_bound) = interpolate_in_time( nest_offl%v_l(0,k,j),                        &
1364                                                      nest_offl%v_l(1,k,j),                        &
1365                                                      fac_dt ) *                                   &
1366                                 MERGE( 1.0_wp, 0.0_wp,                                            &
1367                                        BTEST( wall_flags_total_0(k,j,i_bound), 2 ) )
1368             ENDDO
1369             v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j,i_bound)
1370          ENDDO
1371       ELSE
1372          DO  k = nzb+1, nzt
1373             var_1d(k) = interpolate_in_time( nest_offl%v_l(0,k,1),                                &
1374                                              nest_offl%v_l(1,k,1),                                &
1375                                              fac_dt )
1376          ENDDO
1377          DO  j = nysv, nyn
1378             v(nzb+1:nzt,j,i_bound) = var_1d(nzb+1:nzt) *                                          &
1379                                      MERGE( 1.0_wp, 0.0_wp,                                       &
1380                                             BTEST( wall_flags_total_0(nzb+1:nzt,j,i_bound), 2 ) )
1381             v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j,i_bound)
1382          ENDDO
1383       ENDIF
1384!
1385!--    Potential temperature
1386       IF ( .NOT. neutral )  THEN
1387          IF ( lod == 2 )  THEN
1388             DO  j = nys, nyn
1389                DO  k = nzb+1, nzt
1390                   pt(k,j,i_bound) = interpolate_in_time( nest_offl%pt_l(0,k,j),                   &
1391                                                          nest_offl%pt_l(1,k,j),                   &
1392                                                          fac_dt )
1393                ENDDO
1394                pt_ref_l(nzb+1:nzt) = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j,i_bound)
1395             ENDDO
1396          ELSE
1397             DO  k = nzb+1, nzt
1398                var_1d(k) = interpolate_in_time( nest_offl%pt_l(0,k,1),                            &
1399                                                 nest_offl%pt_l(1,k,1),                            &
1400                                                 fac_dt )
1401             ENDDO
1402             DO  j = nys, nyn
1403                pt(nzb+1:nzt,j,i_bound) = var_1d(nzb+1:nzt)
1404                pt_ref_l(nzb+1:nzt)     = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j,i_bound)
1405             ENDDO
1406          ENDIF
1407       ENDIF
1408!
1409!--    Humidity
1410       IF ( humidity )  THEN
1411          IF ( lod == 2 )  THEN
1412             DO  j = nys, nyn
1413                DO  k = nzb+1, nzt
1414                   q(k,j,i_bound) = interpolate_in_time( nest_offl%q_l(0,k,j),                     &
1415                                                         nest_offl%q_l(1,k,j),                     &
1416                                                         fac_dt )
1417                ENDDO
1418                q_ref_l(nzb+1:nzt) = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j,i_bound)
1419             ENDDO
1420          ELSE
1421             DO  k = nzb+1, nzt
1422                var_1d(k) = interpolate_in_time( nest_offl%q_l(0,k,1),                             &
1423                                                 nest_offl%q_l(1,k,1),                             &
1424                                                 fac_dt )
1425             ENDDO
1426             DO  j = nys, nyn
1427                q(nzb+1:nzt,j,i_bound) = var_1d(nzb+1:nzt)
1428                q_ref_l(nzb+1:nzt)     = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j,i_bound)
1429             ENDDO
1430          ENDIF
1431       ENDIF
1432!
1433!--    Chemistry
1434       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
1435          DO  n = 1, UBOUND( chem_species, 1 )
1436             IF ( nest_offl%chem_from_file_l(n) )  THEN
1437                IF ( lod == 2 )  THEN
1438                   DO  j = nys, nyn
1439                      DO  k = nzb+1, nzt
1440                         chem_species(n)%conc(k,j,i_bound) = interpolate_in_time(                  &
1441                                                                        nest_offl%chem_l(0,k,j,n), &
1442                                                                        nest_offl%chem_l(1,k,j,n), &
1443                                                                        fac_dt                   )
1444                      ENDDO
1445                      ref_chem_l(nzb+1:nzt,n) = ref_chem_l(nzb+1:nzt,n)                            &
1446                                                + chem_species(n)%conc(nzb+1:nzt,j,i_bound)
1447                   ENDDO
1448                ELSE
1449                   DO  k = nzb+1, nzt
1450                      var_1d(k) = interpolate_in_time( nest_offl%chem_l(0,k,1,n),                  &
1451                                                       nest_offl%chem_l(1,k,1,n),                  &
1452                                                       fac_dt )
1453                   ENDDO
1454                   DO  j = nys, nyn
1455                      chem_species(n)%conc(nzb+1:nzt,j,i_bound) = var_1d(nzb+1:nzt)
1456                      ref_chem_l(nzb+1:nzt,n) = ref_chem_l(nzb+1:nzt,n)                            &
1457                                                + chem_species(n)%conc(nzb+1:nzt,j,i_bound)
1458                   ENDDO
1459                ENDIF
1460             ENDIF
1461          ENDDO
1462       ENDIF
1463
1464    ENDIF
1465
1466    IF ( bc_dirichlet_r  )  THEN
1467!
1468!--    u-component
1469       IF ( lod == 2 )  THEN
1470          DO  j = nys, nyn
1471             DO  k = nzb+1, nzt
1472                u(k,j,i_bound_u) = interpolate_in_time( nest_offl%u_r(0,k,j),                      &
1473                                                        nest_offl%u_r(1,k,j),                      &
1474                                                        fac_dt ) *                                 &
1475                                   MERGE( 1.0_wp, 0.0_wp,                                          &
1476                                          BTEST( wall_flags_total_0(k,j,i_bound_u), 1 ) )
1477             ENDDO
1478             u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j,i_bound_u)
1479          ENDDO
1480       ELSE
1481          DO  k = nzb+1, nzt
1482             var_1d(k) = interpolate_in_time( nest_offl%u_r(0,k,1),                                &
1483                                              nest_offl%u_r(1,k,1),                                &
1484                                              fac_dt )
1485          ENDDO
1486          DO  j = nys, nyn
1487             u(nzb+1:nzt,j,i_bound_u) = var_1d(nzb+1:nzt) *                                        &
1488                                      MERGE( 1.0_wp, 0.0_wp,                                       &
1489                                             BTEST( wall_flags_total_0(nzb+1:nzt,j,i_bound_u), 1 ) )
1490             u_ref_l(nzb+1:nzt)       = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j,i_bound_u)
1491          ENDDO
1492       ENDIF
1493!
1494!--    w-component
1495       IF ( lod == 2 )  THEN
1496          DO  j = nys, nyn
1497             DO  k = nzb+1, nzt-1
1498                w(k,j,i_bound) = interpolate_in_time( nest_offl%w_r(0,k,j),                        &
1499                                                      nest_offl%w_r(1,k,j),                        &
1500                                                      fac_dt ) *                                   &
1501                                 MERGE( 1.0_wp, 0.0_wp,                                            &
1502                                        BTEST( wall_flags_total_0(k,j,i_bound), 3 ) )
1503             ENDDO
1504             w(nzt,j,i_bound) = w(nzt-1,j,i_bound)
1505          ENDDO
1506       ELSE
1507          DO  k = nzb+1, nzt-1
1508             var_1d(k) = interpolate_in_time( nest_offl%w_r(0,k,1),                                &
1509                                              nest_offl%w_r(1,k,1),                                &
1510                                              fac_dt )
1511          ENDDO
1512          DO  j = nys, nyn
1513             w(nzb+1:nzt-1,j,i_bound) = var_1d(nzb+1:nzt-1) *                                      &
1514                                  MERGE( 1.0_wp, 0.0_wp,                                           &
1515                                         BTEST( wall_flags_total_0(nzb+1:nzt-1,j,i_bound), 3 ) )
1516             w(nzt,j,i_bound) = w(nzt-1,j,i_bound)
1517          ENDDO
1518       ENDIF
1519!
1520!--    v-component
1521       IF ( lod == 2 )  THEN
1522          DO  j = nysv, nyn
1523             DO  k = nzb+1, nzt
1524                v(k,j,i_bound) = interpolate_in_time( nest_offl%v_r(0,k,j),                        &
1525                                                      nest_offl%v_r(1,k,j),                        &
1526                                                      fac_dt ) *                                   &
1527                                 MERGE( 1.0_wp, 0.0_wp,                                            &
1528                                        BTEST( wall_flags_total_0(k,j,i_bound), 2 ) )
1529             ENDDO
1530             v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j,i_bound)
1531          ENDDO
1532       ELSE
1533          DO  k = nzb+1, nzt
1534             var_1d(k) = interpolate_in_time( nest_offl%v_r(0,k,1),                                &
1535                                              nest_offl%v_r(1,k,1),                                &
1536                                              fac_dt )
1537          ENDDO
1538          DO  j = nysv, nyn
1539             v(nzb+1:nzt,j,i_bound) = var_1d(nzb+1:nzt) *                                          &
1540                                    MERGE( 1.0_wp, 0.0_wp,                                         &
1541                                           BTEST( wall_flags_total_0(nzb+1:nzt,j,i_bound), 2 ) )
1542             v_ref_l(nzb+1:nzt)     = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j,i_bound)
1543          ENDDO
1544       ENDIF
1545!
1546!--    Potential temperature
1547       IF ( .NOT. neutral )  THEN
1548          IF ( lod == 2 )  THEN
1549             DO  j = nys, nyn
1550                DO  k = nzb+1, nzt
1551                   pt(k,j,i_bound) = interpolate_in_time( nest_offl%pt_r(0,k,j),                   &
1552                                                          nest_offl%pt_r(1,k,j),                   &
1553                                                          fac_dt )
1554                ENDDO
1555                pt_ref_l(nzb+1:nzt) = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j,i_bound)
1556             ENDDO
1557          ELSE
1558             DO  k = nzb+1, nzt
1559                var_1d(k) = interpolate_in_time( nest_offl%pt_r(0,k,1),                            &
1560                                                 nest_offl%pt_r(1,k,1),                            &
1561                                                 fac_dt )
1562             ENDDO
1563             DO  j = nys, nyn
1564                pt(nzb+1:nzt,j,i_bound) = var_1d(nzb+1:nzt)
1565                pt_ref_l(nzb+1:nzt)     = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j,i_bound)
1566             ENDDO
1567          ENDIF
1568       ENDIF
1569!
1570!--    Humidity
1571       IF ( humidity )  THEN
1572          IF ( lod == 2 )  THEN
1573             DO  j = nys, nyn
1574                DO  k = nzb+1, nzt
1575                   q(k,j,i_bound) = interpolate_in_time( nest_offl%q_r(0,k,j),                     &
1576                                                         nest_offl%q_r(1,k,j),                     &
1577                                                         fac_dt )
1578                ENDDO
1579                q_ref_l(nzb+1:nzt) = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j,i_bound)
1580             ENDDO
1581          ELSE
1582             DO  k = nzb+1, nzt
1583                var_1d(k) = interpolate_in_time( nest_offl%q_r(0,k,1),                             &
1584                                                 nest_offl%q_r(1,k,1),                             &
1585                                                 fac_dt )
1586             ENDDO
1587             DO  j = nys, nyn
1588                q(nzb+1:nzt,j,i_bound) = var_1d(nzb+1:nzt)
1589                q_ref_l(nzb+1:nzt)     = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j,i_bound)
1590             ENDDO
1591          ENDIF
1592       ENDIF
1593!
1594!--    Chemistry
1595       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
1596          DO  n = 1, UBOUND( chem_species, 1 )
1597             IF ( nest_offl%chem_from_file_r(n) )  THEN
1598                IF ( lod == 2 )  THEN
1599                   DO  j = nys, nyn
1600                      DO  k = nzb+1, nzt
1601                         chem_species(n)%conc(k,j,i_bound) = interpolate_in_time(                  &
1602                                                                        nest_offl%chem_r(0,k,j,n), &
1603                                                                        nest_offl%chem_r(1,k,j,n), &
1604                                                                        fac_dt                   )
1605                      ENDDO
1606                      ref_chem_l(nzb+1:nzt,n) = ref_chem_l(nzb+1:nzt,n)                            &
1607                                                + chem_species(n)%conc(nzb+1:nzt,j,i_bound)
1608                   ENDDO
1609                ELSE
1610                   DO  k = nzb+1, nzt
1611                      var_1d(k) = interpolate_in_time( nest_offl%chem_r(0,k,1,n),                  &
1612                                                       nest_offl%chem_r(1,k,1,n),                  &
1613                                                       fac_dt )
1614                   ENDDO
1615                   DO  j = nys, nyn
1616                      chem_species(n)%conc(nzb+1:nzt,j,i_bound) = var_1d(nzb+1:nzt)
1617                      ref_chem_l(nzb+1:nzt,n) = ref_chem_l(nzb+1:nzt,n)                            &
1618                                                + chem_species(n)%conc(nzb+1:nzt,j,i_bound)
1619                   ENDDO
1620                ENDIF
1621             ENDIF
1622          ENDDO
1623       ENDIF
1624
1625    ENDIF
1626
1627    IF ( bc_dirichlet_n )  THEN
1628!
1629!--    v-component
1630       IF ( lod == 2 )  THEN
1631          DO  i = nxl, nxr
1632             DO  k = nzb+1, nzt
1633                v(k,j_bound_v,i) = interpolate_in_time( nest_offl%v_n(0,k,i),                      &
1634                                                        nest_offl%v_n(1,k,i),                      &
1635                                                        fac_dt ) *                                 &
1636                                   MERGE( 1.0_wp, 0.0_wp,                                          &
1637                                          BTEST( wall_flags_total_0(k,j_bound_v,i), 2 ) )
1638             ENDDO
1639             v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j_bound_v,i)
1640          ENDDO
1641       ELSE
1642          DO  k = nzb+1, nzt
1643             var_1d(k) = interpolate_in_time( nest_offl%v_n(0,k,1),                                &
1644                                              nest_offl%v_n(1,k,1),                                &
1645                                              fac_dt )
1646          ENDDO
1647          DO  i = nxl, nxr
1648             v(nzb+1:nzt,j_bound_v,i) = var_1d(nzb+1:nzt) *                                        &
1649                                  MERGE( 1.0_wp, 0.0_wp,                                           &
1650                                         BTEST( wall_flags_total_0(nzb+1:nzt,j_bound_v,i), 2 ) )
1651             v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j_bound_v,i)
1652          ENDDO
1653       ENDIF
1654!
1655!--    w-component
1656       IF ( lod == 2 )  THEN
1657          DO  i = nxl, nxr
1658             DO  k = nzb+1, nzt-1
1659                w(k,j_bound,i) = interpolate_in_time( nest_offl%w_n(0,k,i),                        &
1660                                                      nest_offl%w_n(1,k,i),                        &
1661                                                      fac_dt ) *                                   &
1662                                 MERGE( 1.0_wp, 0.0_wp,                                            &
1663                                        BTEST( wall_flags_total_0(k,j_bound,i), 3 ) )
1664             ENDDO
1665             w(nzt,j_bound,i) = w(nzt-1,j_bound,i)
1666          ENDDO
1667       ELSE
1668          DO  k = nzb+1, nzt-1
1669             var_1d(k) = interpolate_in_time( nest_offl%w_n(0,k,1),                                &
1670                                              nest_offl%w_n(1,k,1),                                &
1671                                              fac_dt )
1672          ENDDO
1673          DO  i = nxl, nxr
1674             w(nzb+1:nzt-1,j_bound,i) = var_1d(nzb+1:nzt-1) *                                      &
1675                                  MERGE( 1.0_wp, 0.0_wp,                                           &
1676                                         BTEST( wall_flags_total_0(nzb+1:nzt-1,j_bound,i), 3 ) )
1677             w(nzt,j_bound,i) = w(nzt-1,j_bound,i)
1678          ENDDO
1679       ENDIF
1680!
1681!--    u-component
1682       IF ( lod == 2 )  THEN
1683          DO  i = nxlu, nxr
1684             DO  k = nzb+1, nzt
1685                u(k,j_bound,i) = interpolate_in_time( nest_offl%u_n(0,k,i),                        &
1686                                                      nest_offl%u_n(1,k,i),                        &
1687                                                      fac_dt ) *                                   &
1688                                 MERGE( 1.0_wp, 0.0_wp,                                            &
1689                                        BTEST( wall_flags_total_0(k,j_bound,i), 1 ) )
1690             ENDDO
1691             u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j_bound,i)
1692          ENDDO
1693       ELSE
1694          DO  k = nzb+1, nzt
1695             var_1d(k) = interpolate_in_time( nest_offl%u_n(0,k,1),                                &
1696                                              nest_offl%u_n(1,k,1),                                &
1697                                              fac_dt )
1698          ENDDO
1699          DO  i = nxlu, nxr
1700             u(nzb+1:nzt,j_bound,i) = var_1d(nzb+1:nzt) *                                          &
1701                                    MERGE( 1.0_wp, 0.0_wp,                                         &
1702                                           BTEST( wall_flags_total_0(nzb+1:nzt,j_bound,i), 1 ) )
1703             u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j_bound,i)
1704          ENDDO
1705       ENDIF
1706!
1707!--    Potential temperature
1708       IF ( .NOT. neutral )  THEN
1709          IF ( lod == 2 )  THEN
1710             DO  i = nxl, nxr
1711                DO  k = nzb+1, nzt
1712                   pt(k,j_bound,i) = interpolate_in_time( nest_offl%pt_n(0,k,i),                   &
1713                                                          nest_offl%pt_n(1,k,i),                   &
1714                                                          fac_dt )
1715                ENDDO
1716                pt_ref_l(nzb+1:nzt) = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j_bound,i)
1717             ENDDO
1718          ELSE
1719             DO  k = nzb+1, nzt
1720                var_1d(k) = interpolate_in_time( nest_offl%pt_n(0,k,1),                            &
1721                                                 nest_offl%pt_n(1,k,1),                            &
1722                                                 fac_dt )
1723             ENDDO
1724             DO  i = nxl, nxr
1725                pt(nzb+1:nzt,j_bound,i) = var_1d(nzb+1:nzt)
1726                pt_ref_l(nzb+1:nzt)     = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j_bound,i)
1727             ENDDO
1728          ENDIF
1729       ENDIF
1730!
1731!--    Humidity
1732       IF ( humidity )  THEN
1733          IF ( lod == 2 )  THEN
1734             DO  i = nxl, nxr
1735                DO  k = nzb+1, nzt
1736                   q(k,j_bound,i) = interpolate_in_time( nest_offl%q_n(0,k,i),                     &
1737                                                         nest_offl%q_n(1,k,i),                     &
1738                                                         fac_dt )
1739                ENDDO
1740                q_ref_l(nzb+1:nzt) = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j_bound,i)
1741             ENDDO
1742          ELSE
1743             DO  k = nzb+1, nzt
1744                var_1d(k) = interpolate_in_time( nest_offl%q_n(0,k,1),                             &
1745                                                 nest_offl%q_n(1,k,1),                             &
1746                                                 fac_dt )
1747             ENDDO
1748             DO  i = nxl, nxr
1749                q(nzb+1:nzt,j_bound,i) = var_1d(nzb+1:nzt)
1750                q_ref_l(nzb+1:nzt)     = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j_bound,i)
1751             ENDDO
1752          ENDIF
1753       ENDIF
1754!
1755!--    Chemistry
1756       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
1757          DO  n = 1, UBOUND( chem_species, 1 )
1758             IF ( nest_offl%chem_from_file_n(n) )  THEN
1759                IF ( lod == 2 )  THEN
1760                   DO  i = nxl, nxr
1761                      DO  k = nzb+1, nzt
1762                         chem_species(n)%conc(k,j_bound,i) = interpolate_in_time(                  &
1763                                                                     nest_offl%chem_n(0,k,i,n),    &
1764                                                                     nest_offl%chem_n(1,k,i,n),    &
1765                                                                     fac_dt                    )
1766                      ENDDO
1767                      ref_chem_l(nzb+1:nzt,n) = ref_chem_l(nzb+1:nzt,n)                            &
1768                                                + chem_species(n)%conc(nzb+1:nzt,j_bound,i)
1769                   ENDDO
1770                ELSE
1771                   DO  k = nzb+1, nzt
1772                      var_1d(k) = interpolate_in_time( nest_offl%chem_n(0,k,1,n),                  &
1773                                                       nest_offl%chem_n(1,k,1,n),                  &
1774                                                       fac_dt )
1775                   ENDDO
1776                   DO  i = nxl, nxr
1777                      chem_species(n)%conc(nzb+1:nzt,j_bound,i) = var_1d(nzb+1:nzt)
1778                      ref_chem_l(nzb+1:nzt,n)                   = ref_chem_l(nzb+1:nzt,n) +        &
1779                                                                  chem_species(n)                  &
1780                                                                  %conc(nzb+1:nzt,j_bound,i)
1781                   ENDDO
1782                ENDIF
1783             ENDIF
1784          ENDDO
1785       ENDIF
1786    ENDIF
1787
1788    IF ( bc_dirichlet_s )  THEN
1789!
1790!--    v-component
1791       IF ( lod == 2 )  THEN
1792          DO  i = nxl, nxr
1793             DO  k = nzb+1, nzt
1794                v(k,j_bound_v,i) = interpolate_in_time( nest_offl%v_s(0,k,i),                      &
1795                                                        nest_offl%v_s(1,k,i),                      &
1796                                                        fac_dt ) *                                 &
1797                                   MERGE( 1.0_wp, 0.0_wp,                                          &
1798                                          BTEST( wall_flags_total_0(k,j_bound_v,i), 2 ) )
1799             ENDDO
1800             v(:,j_bound_v-1,i) = v(:,j_bound_v,i)
1801             v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j_bound_v,i)
1802          ENDDO
1803       ELSE
1804          DO  k = nzb+1, nzt
1805             var_1d(k) = interpolate_in_time( nest_offl%v_s(0,k,1),                                &
1806                                              nest_offl%v_s(1,k,1),                                &
1807                                              fac_dt )
1808          ENDDO
1809          DO  i = nxl, nxr
1810             v(nzb+1:nzt,j_bound_v,i) = var_1d(nzb+1:nzt) *                                        &
1811                                      MERGE( 1.0_wp, 0.0_wp,                                       &
1812                                             BTEST( wall_flags_total_0(nzb+1:nzt,j_bound_v,i), 2 ) )
1813             v(:,j_bound_v-1,i) = v(:,j_bound_v,i)
1814             v_ref_l(nzb+1:nzt) = v_ref_l(nzb+1:nzt) + v(nzb+1:nzt,j_bound_v,i)
1815          ENDDO
1816       ENDIF
1817!
1818!--    w-component
1819       IF ( lod == 2 )  THEN
1820          DO  i = nxl, nxr
1821             DO  k = nzb+1, nzt-1
1822                w(k,j_bound,i) = interpolate_in_time( nest_offl%w_s(0,k,i),                        &
1823                                                      nest_offl%w_s(1,k,i),                        &
1824                                                      fac_dt ) *                                   &
1825                                 MERGE( 1.0_wp, 0.0_wp,                                            &
1826                                        BTEST( wall_flags_total_0(k,j_bound,i), 3 ) )
1827             ENDDO
1828             w(nzt,j_bound,i) = w(nzt-1,j_bound,i)
1829          ENDDO
1830       ELSE
1831          DO  k = nzb+1, nzt-1
1832             var_1d(k) = interpolate_in_time( nest_offl%w_s(0,k,1),                                &
1833                                              nest_offl%w_s(1,k,1),                                &
1834                                              fac_dt )
1835          ENDDO
1836          DO  i = nxl, nxr
1837             w(nzb+1:nzt-1,j_bound,i) = var_1d(nzb+1:nzt-1) *                                      &
1838                                      MERGE( 1.0_wp, 0.0_wp,                                       &
1839                                             BTEST( wall_flags_total_0(nzb+1:nzt-1,j_bound,i), 3 ) )
1840             w(nzt,j_bound,i) = w(nzt-1,j_bound,i)
1841          ENDDO
1842       ENDIF
1843!
1844!--    u-component
1845       IF ( lod == 2 )  THEN
1846          DO  i = nxlu, nxr
1847             DO  k = nzb+1, nzt
1848                u(k,j_bound,i) = interpolate_in_time( nest_offl%u_s(0,k,i),                        &
1849                                                      nest_offl%u_s(1,k,i),                        &
1850                                                      fac_dt ) *                                   &
1851                                 MERGE( 1.0_wp, 0.0_wp,                                            &
1852                                        BTEST( wall_flags_total_0(k,j_bound,i), 1 ) )
1853             ENDDO
1854             u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j_bound,i)
1855          ENDDO
1856       ELSE
1857          DO  k = nzb+1, nzt
1858             var_1d(k) = interpolate_in_time( nest_offl%u_s(0,k,1),                                &
1859                                              nest_offl%u_s(1,k,1),                                &
1860                                              fac_dt )
1861          ENDDO
1862          DO  i = nxlu, nxr
1863             u(nzb+1:nzt,j_bound,i) = var_1d(nzb+1:nzt) *                                          &
1864                                      MERGE( 1.0_wp, 0.0_wp,                                       &
1865                                             BTEST( wall_flags_total_0(nzb+1:nzt,j_bound,i), 1 ) )
1866             u_ref_l(nzb+1:nzt) = u_ref_l(nzb+1:nzt) + u(nzb+1:nzt,j_bound,i)
1867          ENDDO
1868       ENDIF
1869!
1870!--    Potential temperature
1871       IF ( .NOT. neutral )  THEN
1872          IF ( lod == 2 )  THEN
1873             DO  i = nxl, nxr
1874                DO  k = nzb+1, nzt
1875                   pt(k,j_bound,i) = interpolate_in_time( nest_offl%pt_s(0,k,i),                   &
1876                                                          nest_offl%pt_s(1,k,i),                   &
1877                                                          fac_dt )
1878                ENDDO
1879                pt_ref_l(nzb+1:nzt) = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j_bound,i)
1880             ENDDO
1881          ELSE
1882             DO  k = nzb+1, nzt
1883                var_1d(k) = interpolate_in_time( nest_offl%pt_s(0,k,1),                            &
1884                                                 nest_offl%pt_s(1,k,1),                            &
1885                                                 fac_dt )
1886             ENDDO
1887             DO  i = nxl, nxr
1888                pt(nzb+1:nzt,j_bound,i) = var_1d(nzb+1:nzt)
1889                pt_ref_l(nzb+1:nzt)     = pt_ref_l(nzb+1:nzt) + pt(nzb+1:nzt,j_bound,i)
1890             ENDDO
1891          ENDIF
1892       ENDIF
1893!
1894!--    Humidity
1895       IF ( humidity )  THEN
1896          IF ( lod == 2 )  THEN
1897             DO  i = nxl, nxr
1898                DO  k = nzb+1, nzt
1899                   q(k,j_bound,i) = interpolate_in_time( nest_offl%q_s(0,k,i),                     &
1900                                                         nest_offl%q_s(1,k,i),                     &
1901                                                         fac_dt )
1902                ENDDO
1903                q_ref_l(nzb+1:nzt) = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j_bound,i)
1904             ENDDO
1905          ELSE
1906             DO  k = nzb+1, nzt
1907                var_1d(k) = interpolate_in_time( nest_offl%q_s(0,k,1),                             &
1908                                                 nest_offl%q_s(1,k,1),                             &
1909                                                 fac_dt )
1910             ENDDO
1911             DO  i = nxl, nxr
1912                q(nzb+1:nzt,j_bound,i) = var_1d(nzb+1:nzt)
1913                q_ref_l(nzb+1:nzt)     = q_ref_l(nzb+1:nzt) + q(nzb+1:nzt,j_bound,i)
1914             ENDDO
1915          ENDIF
1916       ENDIF
1917!
1918!--    Chemistry
1919       IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
1920          DO  n = 1, UBOUND( chem_species, 1 )
1921             IF ( nest_offl%chem_from_file_s(n) )  THEN
1922                IF ( lod == 2 )  THEN
1923                   DO  i = nxl, nxr
1924                      DO  k = nzb+1, nzt
1925                         chem_species(n)%conc(k,j_bound,i) = interpolate_in_time(                  &
1926                                                                        nest_offl%chem_s(0,k,i,n), &
1927                                                                        nest_offl%chem_s(1,k,i,n), &
1928                                                                        fac_dt  )
1929                      ENDDO
1930                      ref_chem_l(nzb+1:nzt,n) = ref_chem_l(nzb+1:nzt,n)                            &
1931                                                + chem_species(n)%conc(nzb+1:nzt,j_bound,i)
1932                   ENDDO
1933                ELSE
1934                   DO  k = nzb+1, nzt
1935                      var_1d(k) = interpolate_in_time( nest_offl%chem_s(0,k,1,n),                  &
1936                                                       nest_offl%chem_s(1,k,1,n),                  &
1937                                                       fac_dt )
1938                   ENDDO
1939                   DO  i = nxl, nxr
1940                      chem_species(n)%conc(nzb+1:nzt,j_bound,i) = var_1d(nzb+1:nzt)
1941                      ref_chem_l(nzb+1:nzt,n)                   = ref_chem_l(nzb+1:nzt,n) +        &
1942                                                                  chem_species(n)                  &
1943                                                                  %conc(nzb+1:nzt,j_bound,i)
1944                   ENDDO
1945                ENDIF
1946             ENDIF
1947          ENDDO
1948       ENDIF
1949    ENDIF
1950!
1951!-- Top boundary
1952!-- u-component
1953    IF ( lod == 2 )  THEN
1954       DO  i = nxlu, nxr
1955          DO  j = nys, nyn
1956             u(nzt+1,j,i) = interpolate_in_time( nest_offl%u_top(0,j,i),                           &
1957                                                 nest_offl%u_top(1,j,i),                           &
1958                                                 fac_dt ) *                                        &
1959                            MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzt+1,j,i), 1 ) )
1960             u_ref_l(nzt+1) = u_ref_l(nzt+1) + u(nzt+1,j,i)
1961          ENDDO
1962       ENDDO
1963    ELSE
1964       var_1d(nzt+1) = interpolate_in_time( nest_offl%u_top(0,1,1),                                &
1965                                            nest_offl%u_top(1,1,1),                                &
1966                                            fac_dt )
1967       u(nzt+1,nys:nyn,nxlu:nxr) = var_1d(nzt+1) *                                                 &
1968                                   MERGE( 1.0_wp, 0.0_wp,                                          &
1969                                          BTEST( wall_flags_total_0(nzt+1,nys:nyn,nxlu:nxr), 1 ) )
1970       u_ref_l(nzt+1) = u_ref_l(nzt+1) + SUM( u(nzt+1,nys:nyn,nxlu:nxr) )
1971    ENDIF
1972!
1973!--    For left boundary set boundary condition for u-component also at top grid point.
1974!--    Note, this has no effect on the numeric solution, only for data output.
1975    IF ( bc_dirichlet_l )  u(nzt+1,:,nxl) = u(nzt+1,:,nxlu)
1976!
1977!-- v-component
1978    IF ( lod == 2 )  THEN
1979       DO  i = nxl, nxr
1980          DO  j = nysv, nyn
1981             v(nzt+1,j,i) = interpolate_in_time( nest_offl%v_top(0,j,i),                           &
1982                                                 nest_offl%v_top(1,j,i),                           &
1983                                                 fac_dt ) *                                        &
1984                            MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzt+1,j,i), 2 ) )
1985             v_ref_l(nzt+1) = v_ref_l(nzt+1) + v(nzt+1,j,i)
1986          ENDDO
1987       ENDDO
1988    ELSE
1989       var_1d(nzt+1) = interpolate_in_time( nest_offl%v_top(0,1,1),                                &
1990                                            nest_offl%v_top(1,1,1),                                &
1991                                            fac_dt )
1992       v(nzt+1,nysv:nyn,nxl:nxr) = var_1d(nzt+1) *                                                 &
1993                                   MERGE( 1.0_wp, 0.0_wp,                                          &
1994                                          BTEST( wall_flags_total_0(nzt+1,nysv:nyn,nxl:nxr), 2 ) )
1995       v_ref_l(nzt+1) = v_ref_l(nzt+1) + SUM( v(nzt+1,nysv:nyn,nxl:nxr) )
1996    ENDIF
1997!
1998!-- For south boundary set boundary condition for v-component also at top grid point.
1999!-- Note, this has no effect on the numeric solution, only for data output.
2000    IF ( bc_dirichlet_s )  v(nzt+1,nys,:) = v(nzt+1,nysv,:)
2001!
2002!-- w-component
2003    IF ( lod == 2 )  THEN
2004       DO  i = nxl, nxr
2005          DO  j = nys, nyn
2006             w(nzt,j,i) = interpolate_in_time( nest_offl%w_top(0,j,i),                             &
2007                                               nest_offl%w_top(1,j,i),                             &
2008                                               fac_dt ) *                                          &
2009                          MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(nzt,j,i), 3 ) )
2010             w(nzt+1,j,i) = w(nzt,j,i)
2011          ENDDO
2012       ENDDO
2013    ELSE
2014       var_1d(nzt) = interpolate_in_time( nest_offl%w_top(0,1,1),                                  &
2015                                          nest_offl%w_top(1,1,1),                                  &
2016                                          fac_dt )
2017       w(nzt,nys:nyn,nxl:nxr) = var_1d(nzt) *                                                      &
2018                                MERGE( 1.0_wp, 0.0_wp,                                             &
2019                                       BTEST( wall_flags_total_0(nzt,nys:nyn,nxl:nxr), 3 ) )
2020       w(nzt+1,nys:nyn,nxl:nxr) = w(nzt,nys:nyn,nxl:nxr)
2021    ENDIF
2022!
2023!-- Potential temperture
2024    IF ( .NOT. neutral )  THEN
2025       IF ( lod == 2 )  THEN
2026          DO  i = nxl, nxr
2027             DO  j = nys, nyn
2028                pt(nzt+1,j,i) = interpolate_in_time( nest_offl%pt_top(0,j,i),                      &
2029                                                     nest_offl%pt_top(1,j,i),                      &
2030                                                     fac_dt )
2031                pt_ref_l(nzt+1) = pt_ref_l(nzt+1) + pt(nzt+1,j,i)
2032             ENDDO
2033          ENDDO
2034       ELSE
2035          var_1d(nzt+1) = interpolate_in_time( nest_offl%pt_top(0,1,1),                            &
2036                                               nest_offl%pt_top(1,1,1),                            &
2037                                               fac_dt )
2038          pt(nzt+1,nys:nyn,nxl:nxr) = var_1d(nzt+1)
2039          pt_ref_l(nzt+1) = pt_ref_l(nzt+1) + SUM( pt(nzt+1,nys:nyn,nxl:nxr) )
2040       ENDIF
2041    ENDIF
2042!
2043!--    humidity
2044    IF ( humidity )  THEN
2045       IF ( lod == 2 )  THEN
2046          DO  i = nxl, nxr
2047             DO  j = nys, nyn
2048                q(nzt+1,j,i) = interpolate_in_time( nest_offl%q_top(0,j,i),                        &
2049                                                    nest_offl%q_top(1,j,i),                        &
2050                                                    fac_dt )
2051                q_ref_l(nzt+1) = q_ref_l(nzt+1) + q(nzt+1,j,i)
2052             ENDDO
2053          ENDDO
2054       ELSE
2055          var_1d(nzt+1) = interpolate_in_time( nest_offl%q_top(0,1,1),                             &
2056                                               nest_offl%q_top(1,1,1),                             &
2057                                               fac_dt )
2058          q(nzt+1,nys:nyn,nxl:nxr) = var_1d(nzt+1)
2059          q_ref_l(nzt+1) = q_ref_l(nzt+1) + SUM( q(nzt+1,nys:nyn,nxl:nxr) )
2060       ENDIF
2061    ENDIF
2062
2063    IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
2064       DO  n = 1, UBOUND( chem_species, 1 )
2065          IF ( nest_offl%chem_from_file_t(n) )  THEN
2066             IF ( lod == 2 )  THEN
2067                DO  i = nxl, nxr
2068                   DO  j = nys, nyn
2069                      chem_species(n)%conc(nzt+1,j,i) = interpolate_in_time(                       &
2070                                                           nest_offl%chem_top(0,j,i,n),            &
2071                                                           nest_offl%chem_top(1,j,i,n),            &
2072                                                           fac_dt          )
2073                      ref_chem_l(nzt+1,n) = ref_chem_l(nzt+1,n) + chem_species(n)%conc(nzt+1,j,i)
2074                   ENDDO
2075                ENDDO
2076             ELSE
2077                var_1d(nzt+1) = interpolate_in_time( nest_offl%chem_top(0,1,1,n),                  &
2078                                                     nest_offl%chem_top(1,1,1,n),                  &
2079                                                     fac_dt )
2080                chem_species(n)%conc(nzt+1,nys:nyn,nxl:nxr) = var_1d(nzt+1)
2081                ref_chem_l(nzt+1,n) = ref_chem_l(nzt+1,n) +                                        &
2082                                      SUM( chem_species(n)%conc(nzt+1,nys:nyn,nxl:nxr) )
2083             ENDIF
2084          ENDIF
2085       ENDDO
2086    ENDIF
2087!
2088!-- Moreover, set Neumann boundary condition for subgrid-scale TKE, passive scalar, dissipation, and
2089!-- chemical species if required.
2090    IF ( rans_mode  .AND.  rans_tke_e )  THEN
2091       IF (  bc_dirichlet_l )  diss(:,:,nxl-1) = diss(:,:,nxl)
2092       IF (  bc_dirichlet_r )  diss(:,:,nxr+1) = diss(:,:,nxr)
2093       IF (  bc_dirichlet_s )  diss(:,nys-1,:) = diss(:,nys,:)
2094       IF (  bc_dirichlet_n )  diss(:,nyn+1,:) = diss(:,nyn,:)
2095    ENDIF
2096!        IF ( .NOT. constant_diffusion )  THEN
2097!           IF (  bc_dirichlet_l )  e(:,:,nxl-1) = e(:,:,nxl)
2098!           IF (  bc_dirichlet_r )  e(:,:,nxr+1) = e(:,:,nxr)
2099!           IF (  bc_dirichlet_s )  e(:,nys-1,:) = e(:,nys,:)
2100!           IF (  bc_dirichlet_n )  e(:,nyn+1,:) = e(:,nyn,:)
2101!           e(nzt+1,:,:) = e(nzt,:,:)
2102!        ENDIF
2103!        IF ( passive_scalar )  THEN
2104!           IF (  bc_dirichlet_l )  s(:,:,nxl-1) = s(:,:,nxl)
2105!           IF (  bc_dirichlet_r )  s(:,:,nxr+1) = s(:,:,nxr)
2106!           IF (  bc_dirichlet_s )  s(:,nys-1,:) = s(:,nys,:)
2107!           IF (  bc_dirichlet_n )  s(:,nyn+1,:) = s(:,nyn,:)
2108!        ENDIF
2109
2110    CALL exchange_horiz( u, nbgp )
2111    CALL exchange_horiz( v, nbgp )
2112    CALL exchange_horiz( w, nbgp )
2113    IF ( .NOT. neutral )  CALL exchange_horiz( pt, nbgp )
2114    IF ( humidity      )  CALL exchange_horiz( q,  nbgp )
2115    IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
2116       DO  n = 1, UBOUND( chem_species, 1 )
2117!
2118!--       Do local exchange only when necessary, i.e. when data is coming from dynamic file.
2119          IF ( nest_offl%chem_from_file_t(n) )  CALL exchange_horiz( chem_species(n)%conc, nbgp )
2120       ENDDO
2121    ENDIF
2122!
2123!-- Set top boundary condition at all horizontal grid points, also at the lateral boundary grid
2124!-- points.
2125    w(nzt+1,:,:) = w(nzt,:,:)
2126!
2127!-- Offline nesting for salsa
2128    IF ( salsa )  CALL salsa_nesting_offl_bc
2129!
2130!-- Calculate the mean profiles. These are later stored on u_init, v_init, etc., in order to adjust
2131!-- the Rayleigh damping under time-evolving atmospheric conditions accordingly - damping against
2132!-- the representative mean profiles, not against the initial profiles. Note, in LOD = 1 case no
2133!-- averaging is required.
2134#if defined( __parallel )
2135    CALL MPI_ALLREDUCE( u_ref_l, u_ref, nzt+1-nzb+1, MPI_REAL, MPI_SUM, comm2d, ierr )
2136    CALL MPI_ALLREDUCE( v_ref_l, v_ref, nzt+1-nzb+1, MPI_REAL, MPI_SUM, comm2d, ierr )
2137    IF ( humidity )  THEN
2138       CALL MPI_ALLREDUCE( q_ref_l, q_ref, nzt+1-nzb+1, MPI_REAL, MPI_SUM, comm2d, ierr )
2139    ENDIF
2140    IF ( .NOT. neutral )  THEN
2141       CALL MPI_ALLREDUCE( pt_ref_l, pt_ref, nzt+1-nzb+1, MPI_REAL, MPI_SUM, comm2d, ierr )
2142    ENDIF
2143    IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
2144       CALL MPI_ALLREDUCE( ref_chem_l, ref_chem, ( nzt+1-nzb+1 ) * SIZE( ref_chem(nzb,:) ),        &
2145                           MPI_REAL, MPI_SUM, comm2d, ierr )
2146    ENDIF
2147#else
2148    u_ref  = u_ref_l
2149    v_ref  = v_ref_l
2150    IF ( humidity )       q_ref    = q_ref_l
2151    IF ( .NOT. neutral )  pt_ref   = pt_ref_l
2152    IF ( air_chemistry  .AND.  nesting_offline_chem )  ref_chem = ref_chem_l
2153#endif
2154!
2155!-- Average data. Note, reference profiles up to nzt are derived from lateral boundaries, at the
2156!-- model top it is derived from the top boundary. Thus, number of input data is different from
2157!-- nzb:nzt compared to nzt+1.
2158!-- Derived from lateral boundaries.
2159    u_ref(nzb:nzt) = u_ref(nzb:nzt) / REAL( 2.0_wp * ( ny + 1 + nx     ), KIND = wp )
2160    v_ref(nzb:nzt) = v_ref(nzb:nzt) / REAL( 2.0_wp * ( ny   + nx + 1   ), KIND = wp )
2161    IF ( humidity )                                                                                &
2162       q_ref(nzb:nzt) = q_ref(nzb:nzt)   / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
2163    IF ( .NOT. neutral )                                                                           &
2164       pt_ref(nzb:nzt) = pt_ref(nzb:nzt) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
2165    IF ( air_chemistry  .AND.  nesting_offline_chem )                                              &
2166       ref_chem(nzb:nzt,:) = ref_chem(nzb:nzt,:) / REAL( 2.0_wp * ( ny + 1 + nx + 1 ), KIND = wp )
2167!
2168!-- Derived from top boundary.
2169    u_ref(nzt+1) = u_ref(nzt+1) / REAL( ( ny + 1 ) * ( nx     ), KIND = wp )
2170    v_ref(nzt+1) = v_ref(nzt+1) / REAL( ( ny     ) * ( nx + 1 ), KIND = wp )
2171    IF ( humidity )                                                                                &
2172       q_ref(nzt+1) = q_ref(nzt+1)   / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
2173    IF ( .NOT. neutral )                                                                           &
2174       pt_ref(nzt+1) = pt_ref(nzt+1) / REAL( ( ny + 1 ) * ( nx + 1 ), KIND = wp )
2175    IF ( air_chemistry  .AND.  nesting_offline_chem )                                              &
2176       ref_chem(nzt+1,:) = ref_chem(nzt+1,:) / REAL( ( ny + 1 ) * ( nx + 1 ),KIND = wp )
2177!
2178!-- Write onto init profiles, which are used for damping. Also set lower boundary condition for
2179!-- scalars (not required for u and v as these are zero at k=nzb).
2180    u_init = u_ref
2181    v_init = v_ref
2182    IF ( humidity      )  THEN
2183       q_init      = q_ref
2184       q_init(nzb) = q_init(nzb+1)
2185    ENDIF
2186    IF ( .NOT. neutral )  THEN
2187       pt_init      = pt_ref
2188       pt_init(nzb) = pt_init(nzb+1)
2189    ENDIF
2190
2191    IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
2192       DO  n = 1, UBOUND( chem_species, 1 )
2193          IF ( nest_offl%chem_from_file_t(n) )  THEN
2194             chem_species(n)%conc_pr_init(:)   = ref_chem(:,n)
2195             chem_species(n)%conc_pr_init(nzb) = chem_species(n)%conc_pr_init(nzb+1)
2196          ENDIF
2197       ENDDO
2198    ENDIF
2199    IF ( ALLOCATED( ref_chem   ) )  DEALLOCATE( ref_chem   )
2200    IF ( ALLOCATED( ref_chem_l ) )  DEALLOCATE( ref_chem_l )
2201!
2202!-- Further, adjust Rayleigh damping height in case of time-changing conditions.
2203!-- Therefore, calculate boundary-layer depth first.
2204    CALL nesting_offl_calc_zi
2205    CALL adjust_sponge_layer
2206
2207    CALL  cpu_log( log_point(58), 'offline nesting', 'stop' )
2208
2209    IF ( debug_output_timestep )  CALL debug_message( 'nesting_offl_bc', 'end' )
2210
2211
2212 END SUBROUTINE nesting_offl_bc
2213
2214!--------------------------------------------------------------------------------------------------!
2215! Description:
2216!--------------------------------------------------------------------------------------------------!
2217!>  Update of the geostrophic wind components. Note, currently this routine is not invoked.
2218!--------------------------------------------------------------------------------------------------!
2219 SUBROUTINE nesting_offl_geostrophic_wind
2220
2221    INTEGER(iwp) ::  k
2222!
2223!--    Update geostrophic wind components from dynamic input file.
2224    DO  k = nzb+1, nzt
2225       ug(k) = interpolate_in_time( nest_offl%ug(0,k), nest_offl%ug(1,k), fac_dt )
2226       vg(k) = interpolate_in_time( nest_offl%vg(0,k), nest_offl%vg(1,k), fac_dt )
2227    ENDDO
2228    ug(nzt+1) = ug(nzt)
2229    vg(nzt+1) = vg(nzt)
2230
2231 END SUBROUTINE nesting_offl_geostrophic_wind
2232
2233!--------------------------------------------------------------------------------------------------!
2234! Description:
2235!--------------------------------------------------------------------------------------------------!
2236!>  Determine the interpolation constant for time interpolation. The calculation is separated from
2237!>  the nesting_offl_bc and nesting_offl_geostrophic_wind in order to be independent on the order of
2238!> calls.
2239!--------------------------------------------------------------------------------------------------!
2240 SUBROUTINE nesting_offl_interpolation_factor
2241!
2242!-- Determine interpolation factor and limit it to 1. This is because t+dt can slightly exceed
2243!-- time(tind_p) before boundary data is updated again.
2244    fac_dt = ( time_since_reference_point - nest_offl%time(nest_offl%tind) + dt_3d ) /             &
2245             ( nest_offl%time(nest_offl%tind_p) - nest_offl%time(nest_offl%tind) )
2246
2247    fac_dt = MIN( 1.0_wp, fac_dt )
2248
2249 END SUBROUTINE nesting_offl_interpolation_factor
2250
2251!--------------------------------------------------------------------------------------------------!
2252! Description:
2253!--------------------------------------------------------------------------------------------------!
2254!> Calculates the boundary-layer depth from the boundary data, according to bulk-Richardson
2255!> criterion.
2256!--------------------------------------------------------------------------------------------------!
2257 SUBROUTINE nesting_offl_calc_zi
2258
2259    INTEGER(iwp) :: i                             !< loop index in x-direction
2260    INTEGER(iwp) :: j                             !< loop index in y-direction
2261    INTEGER(iwp) :: k                             !< loop index in z-direction
2262    INTEGER(iwp) :: k_max_loc                     !< index of maximum wind speed along z-direction
2263    INTEGER(iwp) :: k_surface                     !< topography top index in z-direction
2264    INTEGER(iwp) :: num_boundary_gp_non_cyclic    !< number of non-cyclic boundaries, used for averaging ABL depth
2265    INTEGER(iwp) :: num_boundary_gp_non_cyclic_l  !< number of non-cyclic boundaries, used for averaging ABL depth
2266
2267    REAL(wp) ::  ri_bulk                 !< bulk Richardson number
2268    REAL(wp) ::  ri_bulk_crit = 0.25_wp  !< critical bulk Richardson number
2269    REAL(wp) ::  topo_max                !< maximum topography level in model domain
2270    REAL(wp) ::  topo_max_l              !< maximum topography level in subdomain
2271    REAL(wp) ::  vpt_surface             !< near-surface virtual potential temperature
2272    REAL(wp) ::  zi_l                    !< mean boundary-layer depth on subdomain
2273    REAL(wp) ::  zi_local                !< local boundary-layer depth
2274
2275    REAL(wp), DIMENSION(nzb:nzt+1) ::  vpt_col  !< vertical profile of virtual potential temperature at (j,i)-grid point
2276    REAL(wp), DIMENSION(nzb:nzt+1) ::  uv_abs   !< vertical profile of horizontal wind speed at (j,i)-grid point
2277
2278
2279!
2280!-- Calculate mean boundary-layer height from boundary data.
2281!-- Start with the left and right boundaries.
2282    zi_l      = 0.0_wp
2283    num_boundary_gp_non_cyclic_l = 0
2284    IF ( bc_dirichlet_l  .OR.  bc_dirichlet_r )  THEN
2285!
2286!--    Sum-up and store number of boundary grid points used for averaging ABL depth
2287       num_boundary_gp_non_cyclic_l = num_boundary_gp_non_cyclic_l + nxr - nxl + 1
2288!
2289!--    Determine index along x. Please note, index indicates boundary grid point for scalars.
2290       i = MERGE( -1, nxr + 1, bc_dirichlet_l )
2291
2292       DO  j = nys, nyn
2293!
2294!--       Determine topography top index at current (j,i) index
2295          k_surface = topo_top_ind(j,i,0)
2296!
2297!--       Pre-compute surface virtual temperature. Therefore, use 2nd prognostic level according to
2298!--       Heinze et al. (2017).
2299          IF ( humidity )  THEN
2300             vpt_surface = pt(k_surface+2,j,i) * ( 1.0_wp + 0.61_wp * q(k_surface+2,j,i) )
2301             vpt_col     = pt(:,j,i) * ( 1.0_wp + 0.61_wp * q(:,j,i) )
2302          ELSE
2303             vpt_surface = pt(k_surface+2,j,i)
2304             vpt_col     = pt(:,j,i)
2305          ENDIF
2306!
2307!--       Calculate local boundary layer height from bulk Richardson number, i.e. the height where
2308!--       the bulk Richardson number exceeds its critical value of 0.25
2309!--       (according to Heinze et al., 2017).
2310!--       Note, no interpolation of u- and v-component is made, as both are mainly mean inflow
2311!--       profiles with very small spatial variation.
2312!--       Add a safety factor in case the velocity term becomes zero. This may happen if overhanging
2313!--       3D structures are directly located at the boundary, where velocity inside the building is
2314!--       zero (k_surface is the index of the lowest upward-facing surface).
2315          uv_abs(:) = SQRT( MERGE( u(:,j,i+1), u(:,j,i), bc_dirichlet_l )**2 + v(:,j,i)**2 )
2316!
2317!--       Determine index of the maximum wind speed
2318          k_max_loc = MAXLOC( uv_abs(:), DIM = 1 ) - 1
2319
2320          zi_local = 0.0_wp
2321          DO  k = k_surface+1, nzt
2322             ri_bulk = zu(k) * g / vpt_surface *                                                   &
2323                       ( vpt_col(k) - vpt_surface ) / ( uv_abs(k) + 1E-5_wp )
2324!
2325!--          Check if critical Richardson number is exceeded. Further, check if there is a maxium in
2326!--          the wind profile in order to detect also ABL heights in the stable boundary layer.
2327             IF ( zi_local == 0.0_wp  .AND.  ( ri_bulk > ri_bulk_crit .OR. k == k_max_loc ) )      &
2328                zi_local = zu(k)
2329          ENDDO
2330!
2331!--       Assure that the minimum local boundary-layer depth is at least at the second vertical grid
2332!--       level.
2333          zi_l = zi_l + MAX( zi_local, zu(k_surface+2) )
2334
2335       ENDDO
2336
2337    ENDIF
2338!
2339!-- Do the same at the north and south boundaries.
2340    IF ( bc_dirichlet_s  .OR.  bc_dirichlet_n )  THEN
2341
2342       num_boundary_gp_non_cyclic_l = num_boundary_gp_non_cyclic_l + nxr - nxl + 1
2343
2344       j = MERGE( -1, nyn + 1, bc_dirichlet_s )
2345
2346       DO  i = nxl, nxr
2347          k_surface = topo_top_ind(j,i,0)
2348
2349          IF ( humidity )  THEN
2350             vpt_surface = pt(k_surface+2,j,i) * ( 1.0_wp + 0.61_wp * q(k_surface+2,j,i) )
2351             vpt_col     = pt(:,j,i) * ( 1.0_wp + 0.61_wp * q(:,j,i) )
2352          ELSE
2353             vpt_surface = pt(k_surface+2,j,i)
2354             vpt_col  = pt(:,j,i)
2355          ENDIF
2356
2357          uv_abs(:) = SQRT( u(:,j,i)**2 + MERGE( v(:,j+1,i), v(:,j,i), bc_dirichlet_s )**2 )
2358!
2359!--       Determine index of the maximum wind speed
2360          k_max_loc = MAXLOC( uv_abs(:), DIM = 1 ) - 1
2361
2362          zi_local = 0.0_wp
2363          DO  k = k_surface+1, nzt
2364             ri_bulk = zu(k) * g / vpt_surface *                                                   &
2365                       ( vpt_col(k) - vpt_surface ) / ( uv_abs(k) + 1E-5_wp )
2366!
2367!--          Check if critical Richardson number is exceeded. Further, check if there is a maxium in
2368!--          the wind profile in order to detect also ABL heights in the stable boundary layer.
2369             IF ( zi_local == 0.0_wp  .AND.  ( ri_bulk > ri_bulk_crit .OR. k == k_max_loc ) )      &
2370                zi_local = zu(k)
2371          ENDDO
2372          zi_l = zi_l + MAX( zi_local, zu(k_surface+2) )
2373
2374       ENDDO
2375
2376    ENDIF
2377
2378#if defined( __parallel )
2379    CALL MPI_ALLREDUCE( zi_l, zi_ribulk, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
2380    CALL MPI_ALLREDUCE( num_boundary_gp_non_cyclic_l, num_boundary_gp_non_cyclic,                  &
2381                        1, MPI_INTEGER, MPI_SUM, comm2d, ierr )
2382#else
2383    zi_ribulk = zi_l
2384    num_boundary_gp_non_cyclic = num_boundary_gp_non_cyclic_l
2385#endif
2386    zi_ribulk = zi_ribulk / REAL( num_boundary_gp_non_cyclic, KIND = wp )
2387!
2388!-- Finally, check if boundary layer depth is not below the any topography.
2389!-- zi_ribulk will be used to adjust rayleigh damping height, i.e. the lower level of the sponge
2390!-- layer, as well as to adjust the synthetic turbulence generator accordingly. If Rayleigh damping
2391!-- would be applied near buildings, etc., this would spoil the simulation results.
2392    topo_max_l = zw(MAXVAL( topo_top_ind(nys:nyn,nxl:nxr,0) ))
2393
2394#if defined( __parallel )
2395    CALL MPI_ALLREDUCE( topo_max_l, topo_max, 1, MPI_REAL, MPI_MAX, comm2d, ierr )
2396#else
2397    topo_max     = topo_max_l
2398#endif
2399!        zi_ribulk = MAX( zi_ribulk, topo_max )
2400
2401 END SUBROUTINE nesting_offl_calc_zi
2402
2403
2404!--------------------------------------------------------------------------------------------------!
2405! Description:
2406!--------------------------------------------------------------------------------------------------!
2407!> Adjust the height where the rayleigh damping starts, i.e. the lower level of the sponge layer.
2408!--------------------------------------------------------------------------------------------------!
2409 SUBROUTINE adjust_sponge_layer
2410
2411    INTEGER(iwp) :: k   !< loop index in z-direction
2412
2413    REAL(wp) ::  rdh    !< updated Rayleigh damping height
2414
2415
2416    IF ( rayleigh_damping_height > 0.0_wp  .AND.  rayleigh_damping_factor > 0.0_wp )  THEN
2417!
2418!--    Update Rayleigh-damping height and re-calculate height-depending damping coefficients.
2419!--    Assure that rayleigh damping starts well above the boundary layer.
2420       rdh = MIN( MAX( zi_ribulk * 1.3_wp, 10.0_wp * dz(1) ),                                      &
2421                  0.8_wp * zu(nzt), rayleigh_damping_height )
2422!
2423!--       Update Rayleigh damping factor
2424       DO  k = nzb+1, nzt
2425          IF ( zu(k) >= rdh )  THEN
2426             rdf(k) = rayleigh_damping_factor *                                                    &
2427                      ( SIN( pi * 0.5_wp * ( zu(k) - rdh ) / ( zu(nzt) - rdh ) ) )**2
2428          ENDIF
2429       ENDDO
2430       rdf_sc = rdf
2431
2432    ENDIF
2433
2434 END SUBROUTINE adjust_sponge_layer
2435
2436!--------------------------------------------------------------------------------------------------!
2437! Description:
2438! ------------
2439!> Performs consistency checks
2440!--------------------------------------------------------------------------------------------------!
2441 SUBROUTINE nesting_offl_check_parameters
2442!
2443!-- Check if offline nesting is applied in nested child domain.
2444    IF ( nesting_offline  .AND.  child_domain )  THEN
2445       message_string = 'Offline nesting is only applicable in root model.'
2446       CALL message( 'offline_nesting_check_parameters', 'PA0622', 1, 2, 0, 6, 0 )
2447    ENDIF
2448
2449 END SUBROUTINE nesting_offl_check_parameters
2450
2451!--------------------------------------------------------------------------------------------------!
2452! Description:
2453! ------------
2454!> Reads the parameter list nesting_offl_parameters
2455!--------------------------------------------------------------------------------------------------!
2456 SUBROUTINE nesting_offl_parin
2457
2458    CHARACTER(LEN=100) ::  line  !< dummy string that contains the current line of the parameter file
2459
2460    INTEGER(iwp) ::  io_status   !< status after reading the namelist file
2461
2462    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
2463                                             !< although the respective module namelist appears in
2464                                             !< the namelist file
2465
2466    NAMELIST /nesting_offl_parameters/  switch_off_module
2467
2468
2469!
2470!-- Move to the beginning of the namelist file and try to find and read the namelist.
2471    REWIND( 11 )
2472    READ( 11, nesting_offl_parameters, IOSTAT=io_status )
2473
2474!
2475!-- Action depending on the READ status
2476    IF ( io_status == 0 )  THEN
2477!
2478!--    nesting_offl_parameters namelist was found and read correctly. Enable the
2479!--    offline nesting.
2480       IF ( .NOT. switch_off_module )  nesting_offline = .TRUE.
2481
2482    ELSEIF ( io_status > 0 )  THEN
2483!
2484!--    nesting_offl_parameters namelist was found but contained errors. Print an error message
2485!--    including the line that caused the problem.
2486       BACKSPACE( 11 )
2487       READ( 11 , '(A)' ) line
2488       CALL parin_fail_message( 'nesting_offl_parameters', line )
2489
2490    ENDIF
2491
2492 END SUBROUTINE nesting_offl_parin
2493
2494
2495!--------------------------------------------------------------------------------------------------!
2496! Description:
2497! ------------
2498!> Writes information about offline nesting into HEADER file
2499!--------------------------------------------------------------------------------------------------!
2500 SUBROUTINE nesting_offl_header ( io )
2501
2502    INTEGER(iwp), INTENT(IN) ::  io  !< Unit of the output file
2503
2504    WRITE ( io, 1 )
2505    IF ( nesting_offline )  THEN
2506       WRITE ( io, 3 )
2507    ELSE
2508       WRITE ( io, 2 )
2509    ENDIF
2510
25111 FORMAT (//' Offline nesting in COSMO model:'/' -------------------------------'/)
25122 FORMAT (' --> No offlince nesting is used (default) ')
25133 FORMAT (' --> Offlince nesting is used. Boundary data is read from dynamic input file ')
2514
2515 END SUBROUTINE nesting_offl_header
2516
2517
2518!--------------------------------------------------------------------------------------------------!
2519! Description:
2520! ------------
2521!> Allocate arrays used to read boundary data from NetCDF file and initialize boundary data.
2522!--------------------------------------------------------------------------------------------------!
2523 SUBROUTINE nesting_offl_init
2524
2525    INTEGER(iwp) ::  i   !< loop index for x-direction
2526    INTEGER(iwp) ::  j   !< loop index for y-direction
2527    INTEGER(iwp) ::  n   !< running index for chemical species
2528
2529!
2530!-- Before arrays for the boundary data are allocated, the LOD of the dynamic input data at the
2531!-- boundaries is read.
2532#if defined ( __netcdf )
2533!
2534!-- Open file in read-only mode
2535    CALL open_read_file( TRIM( input_file_dynamic ) // TRIM( coupling_char ), pids_id )
2536!
2537!-- Read attributes for LOD. In order to gurantee that also older drivers, where attribute is not
2538!-- given, are working, do not abort the run but assume LOD2 forcing.
2539    CALL get_attribute( pids_id, char_lod, nest_offl%lod_east_pt,  .FALSE., 'ls_forcing_left_pt', .FALSE. )
2540    CALL get_attribute( pids_id, char_lod, nest_offl%lod_east_qv,  .FALSE., 'ls_forcing_left_qv', .FALSE. )
2541    CALL get_attribute( pids_id, char_lod, nest_offl%lod_east_u,   .FALSE., 'ls_forcing_left_u',  .FALSE. )
2542    CALL get_attribute( pids_id, char_lod, nest_offl%lod_east_v,   .FALSE., 'ls_forcing_left_v',  .FALSE. )
2543    CALL get_attribute( pids_id, char_lod, nest_offl%lod_east_w,   .FALSE., 'ls_forcing_left_w',  .FALSE. )
2544
2545    CALL get_attribute( pids_id, char_lod, nest_offl%lod_north_pt, .FALSE., 'ls_forcing_north_pt', .FALSE. )
2546    CALL get_attribute( pids_id, char_lod, nest_offl%lod_north_qv, .FALSE., 'ls_forcing_north_qv', .FALSE. )
2547    CALL get_attribute( pids_id, char_lod, nest_offl%lod_north_u,  .FALSE., 'ls_forcing_north_u',  .FALSE. )
2548    CALL get_attribute( pids_id, char_lod, nest_offl%lod_north_v,  .FALSE., 'ls_forcing_north_v',  .FALSE. )
2549    CALL get_attribute( pids_id, char_lod, nest_offl%lod_north_w,  .FALSE., 'ls_forcing_north_w',  .FALSE. )
2550
2551    CALL get_attribute( pids_id, char_lod, nest_offl%lod_south_pt, .FALSE., 'ls_forcing_south_pt', .FALSE. )
2552    CALL get_attribute( pids_id, char_lod, nest_offl%lod_south_qv, .FALSE., 'ls_forcing_south_qv', .FALSE. )
2553    CALL get_attribute( pids_id, char_lod, nest_offl%lod_south_u,  .FALSE., 'ls_forcing_south_u',  .FALSE. )
2554    CALL get_attribute( pids_id, char_lod, nest_offl%lod_south_v,  .FALSE., 'ls_forcing_south_v',  .FALSE. )
2555    CALL get_attribute( pids_id, char_lod, nest_offl%lod_south_w,  .FALSE., 'ls_forcing_south_w',  .FALSE. )
2556
2557    CALL get_attribute( pids_id, char_lod, nest_offl%lod_west_pt,  .FALSE., 'ls_forcing_right_pt', .FALSE. )
2558    CALL get_attribute( pids_id, char_lod, nest_offl%lod_west_qv,  .FALSE., 'ls_forcing_right_qv', .FALSE. )
2559    CALL get_attribute( pids_id, char_lod, nest_offl%lod_west_u,   .FALSE., 'ls_forcing_right_u',  .FALSE. )
2560    CALL get_attribute( pids_id, char_lod, nest_offl%lod_west_v,   .FALSE., 'ls_forcing_right_v',  .FALSE. )
2561    CALL get_attribute( pids_id, char_lod, nest_offl%lod_west_w,   .FALSE., 'ls_forcing_right_w',  .FALSE. )
2562
2563    CALL get_attribute( pids_id, char_lod, nest_offl%lod_top_pt,   .FALSE., 'ls_forcing_top_pt', .FALSE. )
2564    CALL get_attribute( pids_id, char_lod, nest_offl%lod_top_qv,   .FALSE., 'ls_forcing_top_qv', .FALSE. )
2565    CALL get_attribute( pids_id, char_lod, nest_offl%lod_top_u,    .FALSE., 'ls_forcing_top_u',  .FALSE. )
2566    CALL get_attribute( pids_id, char_lod, nest_offl%lod_top_v,    .FALSE., 'ls_forcing_top_v',  .FALSE. )
2567    CALL get_attribute( pids_id, char_lod, nest_offl%lod_top_w,    .FALSE., 'ls_forcing_top_w',  .FALSE. )
2568
2569    CALL close_input_file( pids_id )
2570#endif
2571!
2572!-- Temporary workaround until most of the dynamic drivers contain a LOD attribute. So far INIFOR
2573!-- did not provide the LOD attribute. In order to still use these older dynamic drivers, provide a
2574!-- temporary workaround. If the LOD is not given, a NetCDF interal error will occur but the
2575!-- simulation will not be aborted since the no_abort flag is passed. However, the respective
2576!-- attribute value might be given an arbitrary number. Hence, check for valid LOD's and manually
2577!-- set them to LOD 2 (as assumed so far). Note, this workaround should be removed later (date of
2578!-- reference: 6. Oct. 2020).
2579    IF ( nest_offl%lod_east_pt /= 1  .AND.  nest_offl%lod_east_pt /= 2 )  nest_offl%lod_east_pt = 2
2580    IF ( nest_offl%lod_east_qv /= 1  .AND.  nest_offl%lod_east_qv /= 2 )  nest_offl%lod_east_qv = 2
2581    IF ( nest_offl%lod_east_u  /= 1  .AND.  nest_offl%lod_east_u  /= 2 )  nest_offl%lod_east_u  = 2
2582    IF ( nest_offl%lod_east_v  /= 1  .AND.  nest_offl%lod_east_v  /= 2 )  nest_offl%lod_east_v  = 2
2583    IF ( nest_offl%lod_east_w  /= 1  .AND.  nest_offl%lod_east_w  /= 2 )  nest_offl%lod_east_w  = 2
2584
2585    IF ( nest_offl%lod_north_pt /= 1  .AND.  nest_offl%lod_north_pt /= 2 )  nest_offl%lod_north_pt = 2
2586    IF ( nest_offl%lod_north_qv /= 1  .AND.  nest_offl%lod_north_qv /= 2 )  nest_offl%lod_north_qv = 2
2587    IF ( nest_offl%lod_north_u  /= 1  .AND.  nest_offl%lod_north_u  /= 2 )  nest_offl%lod_north_u  = 2
2588    IF ( nest_offl%lod_north_v  /= 1  .AND.  nest_offl%lod_north_v  /= 2 )  nest_offl%lod_north_v  = 2
2589    IF ( nest_offl%lod_north_w  /= 1  .AND.  nest_offl%lod_north_w  /= 2 )  nest_offl%lod_north_w  = 2
2590
2591    IF ( nest_offl%lod_south_pt /= 1  .AND.  nest_offl%lod_south_pt /= 2 )  nest_offl%lod_south_pt = 2
2592    IF ( nest_offl%lod_south_qv /= 1  .AND.  nest_offl%lod_south_qv /= 2 )  nest_offl%lod_south_qv = 2
2593    IF ( nest_offl%lod_south_u  /= 1  .AND.  nest_offl%lod_south_u  /= 2 )  nest_offl%lod_south_u  = 2
2594    IF ( nest_offl%lod_south_v  /= 1  .AND.  nest_offl%lod_south_v  /= 2 )  nest_offl%lod_south_v  = 2
2595    IF ( nest_offl%lod_south_w  /= 1  .AND.  nest_offl%lod_south_w  /= 2 )  nest_offl%lod_south_w  = 2
2596
2597    IF ( nest_offl%lod_west_pt /= 1  .AND.  nest_offl%lod_west_pt /= 2 )  nest_offl%lod_west_pt = 2
2598    IF ( nest_offl%lod_west_qv /= 1  .AND.  nest_offl%lod_west_qv /= 2 )  nest_offl%lod_west_qv = 2
2599    IF ( nest_offl%lod_west_u  /= 1  .AND.  nest_offl%lod_west_u  /= 2 )  nest_offl%lod_west_u  = 2
2600    IF ( nest_offl%lod_west_v  /= 1  .AND.  nest_offl%lod_west_v  /= 2 )  nest_offl%lod_west_v  = 2
2601    IF ( nest_offl%lod_west_w  /= 1  .AND.  nest_offl%lod_west_w  /= 2 )  nest_offl%lod_west_w  = 2
2602
2603    IF ( nest_offl%lod_top_pt /= 1  .AND.  nest_offl%lod_top_pt /= 2 )  nest_offl%lod_top_pt = 2
2604    IF ( nest_offl%lod_top_qv /= 1  .AND.  nest_offl%lod_top_qv /= 2 )  nest_offl%lod_top_qv = 2
2605    IF ( nest_offl%lod_top_u  /= 1  .AND.  nest_offl%lod_top_u  /= 2 )  nest_offl%lod_top_u  = 2
2606    IF ( nest_offl%lod_top_v  /= 1  .AND.  nest_offl%lod_top_v  /= 2 )  nest_offl%lod_top_v  = 2
2607    IF ( nest_offl%lod_top_w  /= 1  .AND.  nest_offl%lod_top_w  /= 2 )  nest_offl%lod_top_w  = 2
2608!
2609!-- For consistency, check if all boundary input variables have the same LOD.
2610    IF ( MAX( nest_offl%lod_east_pt,  nest_offl%lod_east_qv,  nest_offl%lod_east_u,                &
2611              nest_offl%lod_east_v,   nest_offl%lod_east_w,                                        &
2612              nest_offl%lod_north_pt, nest_offl%lod_north_qv, nest_offl%lod_north_u,               &
2613              nest_offl%lod_north_v,  nest_offl%lod_north_w,                                       &
2614              nest_offl%lod_south_pt, nest_offl%lod_south_qv, nest_offl%lod_south_u,               &
2615              nest_offl%lod_south_v,  nest_offl%lod_south_w,                                       &
2616              nest_offl%lod_north_pt, nest_offl%lod_north_qv, nest_offl%lod_north_u,               &
2617              nest_offl%lod_north_v,  nest_offl%lod_north_w,                                       &
2618              nest_offl%lod_top_pt,   nest_offl%lod_top_qv,   nest_offl%lod_top_u,                 &
2619              nest_offl%lod_top_v,    nest_offl%lod_top_w )                                        &
2620            /=                                                                                     &
2621         MIN( nest_offl%lod_east_pt,  nest_offl%lod_east_qv,  nest_offl%lod_east_u,                &
2622              nest_offl%lod_east_v,   nest_offl%lod_east_w,                                        &
2623              nest_offl%lod_north_pt, nest_offl%lod_north_qv, nest_offl%lod_north_u,               &
2624              nest_offl%lod_north_v,  nest_offl%lod_north_w,                                       &
2625              nest_offl%lod_south_pt, nest_offl%lod_south_qv, nest_offl%lod_south_u,               &
2626              nest_offl%lod_south_v,  nest_offl%lod_south_w,                                       &
2627              nest_offl%lod_north_pt, nest_offl%lod_north_qv, nest_offl%lod_north_u,               &
2628              nest_offl%lod_north_v,  nest_offl%lod_north_w,                                       &
2629              nest_offl%lod_top_pt,   nest_offl%lod_top_qv,   nest_offl%lod_top_u,                 &
2630              nest_offl%lod_top_v,    nest_offl%lod_top_w ) )  THEN
2631       message_string = 'A mixture of different LOD for the provided boundary data is not ' //     &
2632                        'possible.'
2633       CALL message( 'nesting_offl_init', 'PA0504', 1, 2, 0, 6, 0 )
2634    ENDIF
2635!
2636!-- As all LODs are the same, store it.
2637    lod = nest_offl%lod_east_u
2638!
2639!-- Allocate arrays for geostrophic wind components. Arrays will incorporate 2 time levels in order
2640!-- to interpolate in between.
2641    ALLOCATE( nest_offl%ug(0:1,1:nzt) )
2642    ALLOCATE( nest_offl%vg(0:1,1:nzt) )
2643!
2644!-- Set index range according to the given LOD in order to allocate the input arrays.
2645    IF ( bc_dirichlet_l  .OR.  bc_dirichlet_r  )  THEN
2646       IF ( lod == 2 )  THEN
2647          j_start   = nys
2648          j_start_v = nysv
2649          j_end     = nyn
2650       ELSE
2651          j_start   = 1
2652          j_start_v = 1
2653          j_end     = 1
2654       ENDIF
2655    ENDIF
2656
2657    IF ( bc_dirichlet_n  .OR.  bc_dirichlet_s )  THEN
2658       IF( lod == 2 )  THEN
2659          i_start   = nxl
2660          i_start_u = nxlu
2661          i_end     = nxr
2662       ELSE
2663          i_start   = 1
2664          i_start_u = 1
2665          i_end     = 1
2666       ENDIF
2667    ENDIF
2668!
2669!-- Allocate arrays for reading left/right boundary values. Arrays will incorporate 2 time levels in
2670!-- order to interpolate in between. Depending on the given LOD, the x-, or y-dimension will be
2671!-- either nxl:nxr, or nys:nyn (for LOD=2), or it reduces to one element for LOD=1. If the core has
2672!-- no lateral boundary, allocate a dummy array as well, in order to enable netcdf parallel access.
2673!-- Dummy arrays will be allocated with dimension length zero.
2674    IF ( bc_dirichlet_l )  THEN
2675       ALLOCATE( nest_offl%u_l(0:1,nzb+1:nzt,j_start:j_end)  )
2676       ALLOCATE( nest_offl%v_l(0:1,nzb+1:nzt,j_start_v:j_end) )
2677       ALLOCATE( nest_offl%w_l(0:1,nzb+1:nzt-1,j_start:j_end) )
2678       IF ( humidity )       ALLOCATE( nest_offl%q_l(0:1,nzb+1:nzt,j_start:j_end)  )
2679       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_l(0:1,nzb+1:nzt,j_start:j_end) )
2680       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
2681          ALLOCATE( nest_offl%chem_l(0:1,nzb+1:nzt,j_start:j_end,1:UBOUND( chem_species, 1 )) )
2682    ELSE
2683       ALLOCATE( nest_offl%u_l(1:1,1:1,1:1)  )
2684       ALLOCATE( nest_offl%v_l(1:1,1:1,1:1)  )
2685       ALLOCATE( nest_offl%w_l(1:1,1:1,1:1)  )
2686       IF ( humidity )       ALLOCATE( nest_offl%q_l(1:1,1:1,1:1)  )
2687       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_l(1:1,1:1,1:1)  )
2688       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
2689          ALLOCATE( nest_offl%chem_l(1:1,1:1,1:1,1:UBOUND( chem_species, 1 )) )
2690    ENDIF
2691    IF ( bc_dirichlet_r )  THEN
2692       ALLOCATE( nest_offl%u_r(0:1,nzb+1:nzt,j_start:j_end)  )
2693       ALLOCATE( nest_offl%v_r(0:1,nzb+1:nzt,j_start_v:j_end) )
2694       ALLOCATE( nest_offl%w_r(0:1,nzb+1:nzt-1,j_start:j_end) )
2695       IF ( humidity )       ALLOCATE( nest_offl%q_r(0:1,nzb+1:nzt,j_start:j_end)  )
2696       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_r(0:1,nzb+1:nzt,j_start:j_end) )
2697       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
2698          ALLOCATE( nest_offl%chem_r(0:1,nzb+1:nzt,j_start:j_end,1:UBOUND( chem_species, 1 )) )
2699    ELSE
2700       ALLOCATE( nest_offl%u_r(1:1,1:1,1:1)  )
2701       ALLOCATE( nest_offl%v_r(1:1,1:1,1:1)  )
2702       ALLOCATE( nest_offl%w_r(1:1,1:1,1:1)  )
2703       IF ( humidity )       ALLOCATE( nest_offl%q_r(1:1,1:1,1:1)  )
2704       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_r(1:1,1:1,1:1)  )
2705       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
2706          ALLOCATE( nest_offl%chem_r(1:1,1:1,1:1,1:UBOUND( chem_species, 1 )) )
2707    ENDIF
2708!
2709!-- Allocate arrays for reading north/south boundary values. Arrays will incorporate 2 time levels
2710!-- in order to interpolate in between. If the core has no boundary, allocate a dummy array, in
2711!-- order to enable netcdf parallel access. Dummy arrays will be allocated with dimension length
2712!-- zero.
2713    IF ( bc_dirichlet_n )  THEN
2714       ALLOCATE( nest_offl%u_n(0:1,nzb+1:nzt,i_start_u:i_end) )
2715       ALLOCATE( nest_offl%v_n(0:1,nzb+1:nzt,i_start:i_end)  )
2716       ALLOCATE( nest_offl%w_n(0:1,nzb+1:nzt-1,i_start:i_end) )
2717       IF ( humidity )       ALLOCATE( nest_offl%q_n(0:1,nzb+1:nzt,i_start:i_end)  )
2718       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_n(0:1,nzb+1:nzt,i_start:i_end) )
2719       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
2720          ALLOCATE( nest_offl%chem_n(0:1,nzb+1:nzt,i_start:i_end,1:UBOUND( chem_species, 1 )) )
2721    ELSE
2722       ALLOCATE( nest_offl%u_n(1:1,1:1,1:1)  )
2723       ALLOCATE( nest_offl%v_n(1:1,1:1,1:1)  )
2724       ALLOCATE( nest_offl%w_n(1:1,1:1,1:1)  )
2725       IF ( humidity )       ALLOCATE( nest_offl%q_n(1:1,1:1,1:1)  )
2726       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_n(1:1,1:1,1:1)  )
2727       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
2728          ALLOCATE( nest_offl%chem_n(1:1,1:1,1:1,1:UBOUND( chem_species, 1 )) )
2729    ENDIF
2730    IF ( bc_dirichlet_s )  THEN
2731       ALLOCATE( nest_offl%u_s(0:1,nzb+1:nzt,i_start_u:i_end) )
2732       ALLOCATE( nest_offl%v_s(0:1,nzb+1:nzt,i_start:i_end)  )
2733       ALLOCATE( nest_offl%w_s(0:1,nzb+1:nzt-1,i_start:i_end) )
2734       IF ( humidity )       ALLOCATE( nest_offl%q_s(0:1,nzb+1:nzt,i_start:i_end)  )
2735       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_s(0:1,nzb+1:nzt,i_start:i_end) )
2736       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
2737          ALLOCATE( nest_offl%chem_s(0:1,nzb+1:nzt,i_start:i_end,1:UBOUND( chem_species, 1 )) )
2738    ELSE
2739       ALLOCATE( nest_offl%u_s(1:1,1:1,1:1)  )
2740       ALLOCATE( nest_offl%v_s(1:1,1:1,1:1)  )
2741       ALLOCATE( nest_offl%w_s(1:1,1:1,1:1)  )
2742       IF ( humidity )       ALLOCATE( nest_offl%q_s(1:1,1:1,1:1)  )
2743       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_s(1:1,1:1,1:1)  )
2744       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
2745          ALLOCATE( nest_offl%chem_s(1:1,1:1,1:1,1:UBOUND( chem_species, 1 )) )
2746    ENDIF
2747!
2748!-- Allocate arrays for reading data at the top boundary. In contrast to the lateral boundaries,
2749!-- each core reads these data so that no dummy arrays need to be allocated.
2750    IF ( lod == 2 )  THEN
2751       ALLOCATE( nest_offl%u_top(0:1,nys:nyn,nxlu:nxr) )
2752       ALLOCATE( nest_offl%v_top(0:1,nysv:nyn,nxl:nxr) )
2753       ALLOCATE( nest_offl%w_top(0:1,nys:nyn,nxl:nxr)  )
2754       IF ( humidity )       ALLOCATE( nest_offl%q_top(0:1,nys:nyn,nxl:nxr)  )
2755       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_top(0:1,nys:nyn,nxl:nxr) )
2756       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
2757          ALLOCATE( nest_offl%chem_top(0:1,nys:nyn,nxl:nxr,1:UBOUND( chem_species, 1 )) )
2758    ELSE
2759       ALLOCATE( nest_offl%u_top(0:1,1:1,1:1) )
2760       ALLOCATE( nest_offl%v_top(0:1,1:1,1:1) )
2761       ALLOCATE( nest_offl%w_top(0:1,1:1,1:1)  )
2762       IF ( humidity )       ALLOCATE( nest_offl%q_top(0:1,1:1,1:1)  )
2763       IF ( .NOT. neutral )  ALLOCATE( nest_offl%pt_top(0:1,1:1,1:1) )
2764       IF ( air_chemistry  .AND.  nesting_offline_chem )                                           &
2765          ALLOCATE( nest_offl%chem_top(0:1,1:1,1:1,1:UBOUND( chem_species, 1 )) )
2766    ENDIF
2767!
2768!-- For chemical species, create the names of the variables. This is necessary to identify the
2769!-- respective variable and write it onto the correct array in the chem_species datatype.
2770    IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
2771       ALLOCATE( nest_offl%chem_from_file_l(1:UBOUND( chem_species, 1 )) )
2772       ALLOCATE( nest_offl%chem_from_file_n(1:UBOUND( chem_species, 1 )) )
2773       ALLOCATE( nest_offl%chem_from_file_r(1:UBOUND( chem_species, 1 )) )
2774       ALLOCATE( nest_offl%chem_from_file_s(1:UBOUND( chem_species, 1 )) )
2775       ALLOCATE( nest_offl%chem_from_file_t(1:UBOUND( chem_species, 1 )) )
2776
2777       ALLOCATE( nest_offl%var_names_chem_l(1:UBOUND( chem_species, 1 )) )
2778       ALLOCATE( nest_offl%var_names_chem_n(1:UBOUND( chem_species, 1 )) )
2779       ALLOCATE( nest_offl%var_names_chem_r(1:UBOUND( chem_species, 1 )) )
2780       ALLOCATE( nest_offl%var_names_chem_s(1:UBOUND( chem_species, 1 )) )
2781       ALLOCATE( nest_offl%var_names_chem_t(1:UBOUND( chem_species, 1 )) )
2782!
2783!--    Initialize flags that indicate whether the variable is on file or not. Please note, this is
2784!--    only necessary for chemistry variables.
2785       nest_offl%chem_from_file_l(:) = .FALSE.
2786       nest_offl%chem_from_file_n(:) = .FALSE.
2787       nest_offl%chem_from_file_r(:) = .FALSE.
2788       nest_offl%chem_from_file_s(:) = .FALSE.
2789       nest_offl%chem_from_file_t(:) = .FALSE.
2790
2791       DO  n = 1, UBOUND( chem_species, 1 )
2792          nest_offl%var_names_chem_l(n) = nest_offl%char_l // TRIM(chem_species(n)%name)
2793          nest_offl%var_names_chem_n(n) = nest_offl%char_n // TRIM(chem_species(n)%name)
2794          nest_offl%var_names_chem_r(n) = nest_offl%char_r // TRIM(chem_species(n)%name)
2795          nest_offl%var_names_chem_s(n) = nest_offl%char_s // TRIM(chem_species(n)%name)
2796          nest_offl%var_names_chem_t(n) = nest_offl%char_t // TRIM(chem_species(n)%name)
2797       ENDDO
2798    ENDIF
2799!
2800!-- Offline nesting for salsa
2801    IF ( salsa )  CALL salsa_nesting_offl_init
2802!
2803!-- Before initial data input is initiated, check if dynamic input file is present.
2804    IF ( .NOT. input_pids_dynamic )  THEN
2805       message_string = 'nesting_offline = .TRUE. requires dynamic '  //                           &
2806                         'input file ' // TRIM( input_file_dynamic ) // TRIM( coupling_char )
2807       CALL message( 'nesting_offl_init', 'PA0546', 1, 2, 0, 6, 0 )
2808    ENDIF
2809!
2810!-- Read COSMO data at lateral and top boundaries
2811    CALL nesting_offl_input
2812!
2813!-- Check if sufficient time steps are provided to cover the entire simulation. Note, dynamic input
2814!-- is only required for the 3D simulation, not for the soil/wall spinup. However, as the spinup
2815!-- time is added to the end_time, this must be considered here.
2816    IF ( end_time - spinup_time > nest_offl%time(nest_offl%nt-1) )  THEN
2817       message_string = 'end_time of the simulation exceeds the ' //                               &
2818                        'time dimension in the dynamic input file.'
2819       CALL message( 'nesting_offl_init', 'PA0183', 1, 2, 0, 6, 0 )
2820    ENDIF
2821!
2822!-- Set indicies for boundary grid points
2823    IF ( bc_dirichlet_l  .OR.  bc_dirichlet_r )  THEN
2824       i_bound   = MERGE( nxl  - 1, nxr + 1, bc_dirichlet_l )
2825       i_bound_u = MERGE( nxlu - 1, nxr + 1, bc_dirichlet_l )
2826    ENDIF
2827    IF ( bc_dirichlet_n  .OR.  bc_dirichlet_s )  THEN
2828       j_bound   = MERGE( nys  - 1, nyn + 1, bc_dirichlet_s )
2829       j_bound_v = MERGE( nysv - 1, nyn + 1, bc_dirichlet_s )
2830    ENDIF
2831!
2832!-- Initialize boundary data. Please note, do not initialize boundaries in case of restart runs.
2833!-- This case the boundaries are already initialized and the boundary data from file would be on the
2834!-- wrong time level.
2835    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
2836!
2837!--    Distinguish between LOD = 1 and LOD = 2 inititialization
2838       IF ( lod == 2 )  THEN
2839          IF ( bc_dirichlet_l )  THEN
2840             u(nzb+1:nzt,nys:nyn,i_bound_u) = nest_offl%u_l(0,nzb+1:nzt,nys:nyn)
2841             v(nzb+1:nzt,nysv:nyn,i_bound)  = nest_offl%v_l(0,nzb+1:nzt,nysv:nyn)
2842             w(nzb+1:nzt-1,nys:nyn,i_bound) = nest_offl%w_l(0,nzb+1:nzt-1,nys:nyn)
2843             IF ( .NOT. neutral )  pt(nzb+1:nzt,nys:nyn,i_bound) = nest_offl%pt_l(0,nzb+1:nzt,nys:nyn)
2844             IF ( humidity      )  q(nzb+1:nzt,nys:nyn,i_bound)  = nest_offl%q_l(0,nzb+1:nzt,nys:nyn)
2845             IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
2846                DO  n = 1, UBOUND( chem_species, 1 )
2847                   IF( nest_offl%chem_from_file_l(n) )  THEN
2848                      chem_species(n)%conc(nzb+1:nzt,nys:nyn,i_bound) =                            &
2849                                                             nest_offl%chem_l(0,nzb+1:nzt,nys:nyn,n)
2850                   ENDIF
2851                ENDDO
2852             ENDIF
2853          ENDIF
2854          IF ( bc_dirichlet_r )  THEN
2855             u(nzb+1:nzt,nys:nyn,i_bound_u) = nest_offl%u_r(0,nzb+1:nzt,nys:nyn)
2856             v(nzb+1:nzt,nysv:nyn,i_bound)  = nest_offl%v_r(0,nzb+1:nzt,nysv:nyn)
2857             w(nzb+1:nzt-1,nys:nyn,i_bound) = nest_offl%w_r(0,nzb+1:nzt-1,nys:nyn)
2858             IF ( .NOT. neutral )  pt(nzb+1:nzt,nys:nyn,i_bound) = nest_offl%pt_r(0,nzb+1:nzt,nys:nyn)
2859             IF ( humidity      )  q(nzb+1:nzt,nys:nyn,i_bound)  = nest_offl%q_r(0,nzb+1:nzt,nys:nyn)
2860             IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
2861                DO  n = 1, UBOUND( chem_species, 1 )
2862                   IF( nest_offl%chem_from_file_r(n) )  THEN
2863                      chem_species(n)%conc(nzb+1:nzt,nys:nyn,i_bound) =                            &
2864                                                             nest_offl%chem_r(0,nzb+1:nzt,nys:nyn,n)
2865                   ENDIF
2866                ENDDO
2867             ENDIF
2868          ENDIF
2869
2870          IF ( bc_dirichlet_n)  THEN
2871             u(nzb+1:nzt,j_bound,nxlu:nxr)  = nest_offl%u_n(0,nzb+1:nzt,nxlu:nxr)
2872             v(nzb+1:nzt,j_bound_v,nxl:nxr) = nest_offl%v_n(0,nzb+1:nzt,nxl:nxr)
2873             w(nzb+1:nzt-1,j_bound,nxl:nxr) = nest_offl%w_n(0,nzb+1:nzt-1,nxl:nxr)
2874             IF ( .NOT. neutral )  pt(nzb+1:nzt,j_bound,nxl:nxr) = nest_offl%pt_n(0,nzb+1:nzt,nxl:nxr)
2875             IF ( humidity      )  q(nzb+1:nzt,j_bound,nxl:nxr)  = nest_offl%q_n(0,nzb+1:nzt,nxl:nxr)
2876             IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
2877                DO  n = 1, UBOUND( chem_species, 1 )
2878                   IF( nest_offl%chem_from_file_n(n) )  THEN
2879                      chem_species(n)%conc(nzb+1:nzt,j_bound,nxl:nxr) =                            &
2880                                                             nest_offl%chem_n(0,nzb+1:nzt,nxl:nxr,n)
2881                   ENDIF
2882                ENDDO
2883             ENDIF
2884          ENDIF
2885          IF ( bc_dirichlet_s)  THEN
2886             u(nzb+1:nzt,j_bound,nxlu:nxr)  = nest_offl%u_s(0,nzb+1:nzt,nxlu:nxr)
2887             v(nzb+1:nzt,j_bound_v,nxl:nxr) = nest_offl%v_s(0,nzb+1:nzt,nxl:nxr)
2888             w(nzb+1:nzt-1,j_bound,nxl:nxr) = nest_offl%w_s(0,nzb+1:nzt-1,nxl:nxr)
2889             IF ( .NOT. neutral )  pt(nzb+1:nzt,j_bound,nxl:nxr) = nest_offl%pt_s(0,nzb+1:nzt,nxl:nxr)
2890             IF ( humidity      )  q(nzb+1:nzt,j_bound,nxl:nxr)  = nest_offl%q_s(0,nzb+1:nzt,nxl:nxr)
2891             IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
2892                DO  n = 1, UBOUND( chem_species, 1 )
2893                   IF( nest_offl%chem_from_file_s(n) )  THEN
2894                      chem_species(n)%conc(nzb+1:nzt,j_bound,nxl:nxr) =                            &
2895                                                             nest_offl%chem_s(0,nzb+1:nzt,nxl:nxr,n)
2896                   ENDIF
2897                ENDDO
2898             ENDIF
2899          ENDIF
2900
2901          u(nzt+1,nys:nyn,nxlu:nxr) = nest_offl%u_top(0,nys:nyn,nxlu:nxr)
2902          v(nzt+1,nysv:nyn,nxl:nxr) = nest_offl%v_top(0,nysv:nyn,nxl:nxr)
2903          w(nzt,nys:nyn,nxl:nxr)    = nest_offl%w_top(0,nys:nyn,nxl:nxr)
2904          w(nzt+1,nys:nyn,nxl:nxr)  = nest_offl%w_top(0,nys:nyn,nxl:nxr)
2905          IF ( .NOT. neutral )  pt(nzt+1,nys:nyn,nxl:nxr) = nest_offl%pt_top(0,nys:nyn,nxl:nxr)
2906          IF ( humidity )       q(nzt+1,nys:nyn,nxl:nxr)  = nest_offl%q_top(0,nys:nyn,nxl:nxr)
2907          IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
2908             DO  n = 1, UBOUND( chem_species, 1 )
2909                IF( nest_offl%chem_from_file_t(n) )  THEN
2910                   chem_species(n)%conc(nzt+1,nys:nyn,nxl:nxr) =                                   &
2911                                                             nest_offl%chem_top(0,nys:nyn,nxl:nxr,n)
2912                ENDIF
2913             ENDDO
2914          ENDIF
2915!
2916!--    LOD 1
2917       ELSE
2918          IF ( bc_dirichlet_l )  THEN
2919             DO  j = nys, nyn
2920                u(nzb+1:nzt,j,i_bound_u) = nest_offl%u_l(0,nzb+1:nzt,1)
2921                w(nzb+1:nzt-1,j,i_bound) = nest_offl%w_l(0,nzb+1:nzt-1,1)
2922             ENDDO
2923             DO  j = nysv, nyn
2924                v(nzb+1:nzt,j,i_bound)  = nest_offl%v_l(0,nzb+1:nzt,1)
2925             ENDDO
2926             IF ( .NOT. neutral )  THEN
2927                DO  j = nys, nyn
2928                   pt(nzb+1:nzt,j,i_bound) = nest_offl%pt_l(0,nzb+1:nzt,1)
2929                ENDDO
2930             ENDIF
2931             IF ( humidity      )  THEN
2932                DO  j = nys, nyn
2933                   q(nzb+1:nzt,j,i_bound)  = nest_offl%q_l(0,nzb+1:nzt,1)
2934                ENDDO
2935             ENDIF
2936             IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
2937                DO  n = 1, UBOUND( chem_species, 1 )
2938                   IF( nest_offl%chem_from_file_l(n) )  THEN
2939                      DO  j = nys, nyn
2940                         chem_species(n)%conc(nzb+1:nzt,j,i_bound) =                               &
2941                                                                   nest_offl%chem_l(0,nzb+1:nzt,1,n)
2942                      ENDDO
2943                   ENDIF
2944                ENDDO
2945             ENDIF
2946          ENDIF
2947          IF ( bc_dirichlet_r )  THEN
2948             DO  j = nys, nyn
2949                u(nzb+1:nzt,j,i_bound_u) = nest_offl%u_r(0,nzb+1:nzt,1)
2950                w(nzb+1:nzt-1,j,i_bound) = nest_offl%w_r(0,nzb+1:nzt-1,1)
2951             ENDDO
2952             DO  j = nysv, nyn
2953                v(nzb+1:nzt,j,i_bound)  = nest_offl%v_r(0,nzb+1:nzt,1)
2954             ENDDO
2955             IF ( .NOT. neutral )  THEN
2956                DO  j = nys, nyn
2957                   pt(nzb+1:nzt,j,i_bound) = nest_offl%pt_r(0,nzb+1:nzt,1)
2958                ENDDO
2959             ENDIF
2960             IF ( humidity      )  THEN
2961                DO  j = nys, nyn
2962                   q(nzb+1:nzt,j,i_bound)  = nest_offl%q_r(0,nzb+1:nzt,1)
2963                ENDDO
2964             ENDIF
2965             IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
2966                DO  n = 1, UBOUND( chem_species, 1 )
2967                   IF( nest_offl%chem_from_file_r(n) )  THEN
2968                      DO  j = nys, nyn
2969                         chem_species(n)%conc(nzb+1:nzt,j,i_bound) =                               &
2970                                                                   nest_offl%chem_r(0,nzb+1:nzt,1,n)
2971                      ENDDO
2972                   ENDIF
2973                ENDDO
2974             ENDIF
2975          ENDIF
2976          IF ( bc_dirichlet_n )  THEN
2977             DO  i = nxlu, nxr
2978                u(nzb+1:nzt,j_bound,i)  = nest_offl%u_n(0,nzb+1:nzt,1)
2979             ENDDO
2980             DO  i = nxl, nxr
2981                v(nzb+1:nzt,j_bound_v,i) = nest_offl%v_n(0,nzb+1:nzt,1)
2982                w(nzb+1:nzt-1,j_bound,i) = nest_offl%w_n(0,nzb+1:nzt-1,1)
2983             ENDDO
2984             IF ( .NOT. neutral )  THEN
2985                DO  i = nxl, nxr
2986                   pt(nzb+1:nzt,j_bound,i) = nest_offl%pt_n(0,nzb+1:nzt,1)
2987                ENDDO
2988             ENDIF
2989             IF ( humidity      )  THEN
2990                DO  i = nxl, nxr
2991                   q(nzb+1:nzt,j_bound,i)  = nest_offl%q_n(0,nzb+1:nzt,1)
2992                ENDDO
2993             ENDIF
2994             IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
2995                DO  n = 1, UBOUND( chem_species, 1 )
2996                   IF( nest_offl%chem_from_file_n(n) )  THEN
2997                      DO  i = nxl, nxr
2998                         chem_species(n)%conc(nzb+1:nzt,j_bound,i) =                               &
2999                                                                   nest_offl%chem_n(0,nzb+1:nzt,1,n)
3000                      ENDDO
3001                   ENDIF
3002                ENDDO
3003             ENDIF
3004          ENDIF
3005          IF ( bc_dirichlet_s )  THEN
3006             DO  i = nxlu, nxr
3007                u(nzb+1:nzt,j_bound,i)  = nest_offl%u_s(0,nzb+1:nzt,1)
3008             ENDDO
3009             DO  i = nxl, nxr
3010                v(nzb+1:nzt,j_bound_v,i) = nest_offl%v_s(0,nzb+1:nzt,1)
3011                w(nzb+1:nzt-1,j_bound,i) = nest_offl%w_s(0,nzb+1:nzt-1,1)
3012             ENDDO
3013             IF ( .NOT. neutral )  THEN
3014                DO  i = nxl, nxr
3015                   pt(nzb+1:nzt,j_bound,i) = nest_offl%pt_s(0,nzb+1:nzt,1)
3016                ENDDO
3017             ENDIF
3018             IF ( humidity      )  THEN
3019                DO  i = nxl, nxr
3020                   q(nzb+1:nzt,j_bound,i)  = nest_offl%q_s(0,nzb+1:nzt,1)
3021                ENDDO
3022             ENDIF
3023             IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
3024                DO  n = 1, UBOUND( chem_species, 1 )
3025                   IF( nest_offl%chem_from_file_s(n) )  THEN
3026                      DO  i = nxl, nxr
3027                         chem_species(n)%conc(nzb+1:nzt,j_bound,i) =                               &
3028                                                                   nest_offl%chem_s(0,nzb+1:nzt,1,n)
3029                      ENDDO
3030                   ENDIF
3031                ENDDO
3032             ENDIF
3033          ENDIF
3034
3035          u(nzt+1,nys:nyn,nxlu:nxr) = nest_offl%u_top(0,1,1)
3036          v(nzt+1,nysv:nyn,nxl:nxr) = nest_offl%v_top(0,1,1)
3037          w(nzt,nys:nyn,nxl:nxr)    = nest_offl%w_top(0,1,1)
3038          w(nzt+1,nys:nyn,nxl:nxr)  = nest_offl%w_top(0,1,1)
3039          IF ( .NOT. neutral )  pt(nzt+1,nys:nyn,nxl:nxr) = nest_offl%pt_top(0,1,1)
3040          IF ( humidity )       q(nzt+1,nys:nyn,nxl:nxr)  = nest_offl%q_top(0,1,1)
3041          IF ( air_chemistry  .AND.  nesting_offline_chem )  THEN
3042             DO  n = 1, UBOUND( chem_species, 1 )
3043                IF( nest_offl%chem_from_file_t(n) )  THEN
3044                   chem_species(n)%conc(nzt+1,nys:nyn,nxl:nxr) = nest_offl%chem_top(0,1,1,n)
3045                ENDIF
3046             ENDDO
3047          ENDIF
3048       ENDIF
3049!
3050!--    In case of offline nesting the pressure forms itself based on the prescribed lateral
3051!--    boundary conditions. Hence, explicit forcing by pressure gradients via geostrophic wind
3052!--    components is not necessary and would be canceled out by the perturbation pressure otherwise.
3053!--    For this reason, set geostrophic wind components to zero.
3054       ug(nzb+1:nzt) = 0.0_wp
3055       vg(nzb+1:nzt) = 0.0_wp
3056
3057    ENDIF
3058!
3059!-- After boundary data is initialized, mask topography at the boundaries for the velocity
3060!-- components.
3061    u = MERGE( u, 0.0_wp, BTEST( wall_flags_total_0, 1 ) )
3062    v = MERGE( v, 0.0_wp, BTEST( wall_flags_total_0, 2 ) )
3063    w = MERGE( w, 0.0_wp, BTEST( wall_flags_total_0, 3 ) )
3064!
3065!-- Initial calculation of the boundary layer depth from the prescribed boundary data. This is
3066!-- required for initialize the synthetic turbulence generator correctly.
3067    CALL nesting_offl_calc_zi
3068!
3069!-- After boundary data is initialized, ensure mass conservation. Not necessary in restart runs.
3070    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
3071       CALL nesting_offl_mass_conservation
3072    ENDIF
3073
3074 END SUBROUTINE nesting_offl_init
3075
3076!--------------------------------------------------------------------------------------------------!
3077! Description:
3078!--------------------------------------------------------------------------------------------------!
3079!> Interpolation function, used to interpolate boundary data in time.
3080!--------------------------------------------------------------------------------------------------!
3081 FUNCTION interpolate_in_time( var_t1, var_t2, fac  )
3082
3083    REAL(wp)            :: fac                  !< interpolation factor
3084    REAL(wp)            :: interpolate_in_time  !< time-interpolated boundary value
3085    REAL(wp)            :: var_t1               !< boundary value at t1
3086    REAL(wp)            :: var_t2               !< boundary value at t2
3087
3088    interpolate_in_time = ( 1.0_wp - fac ) * var_t1 + fac * var_t2
3089
3090 END FUNCTION interpolate_in_time
3091
3092
3093
3094 END MODULE nesting_offl_mod
Note: See TracBrowser for help on using the repository browser.