Home

Context Navigation

init_grid.f90 @ 420

Last change on this file since 420 was 392, checked in by raasch, 15 years ago

New:
---

Adapted for machine lck
(mrun, mbuild, subjob)

bc_lr/bc_ns in most subroutines replaced by LOGICAL variables bc_lr_cyc,
bc_ns_cyc for speed optimization
(check_parameters, diffusion_u, diffusion_v, diffusion_w, modules)

Additional timestep criterion in case of simulations with plant canopy (timestep)

Check for illegal entries in section_xy|xz|yz that exceed nz+1|ny+1|nx+1
(check_parameters)

Clipping of dvrp output implemented. Default colourtable for particles
implemented, particle attributes (color, dvrp_size) can be set with new
parameters particle_color, particle_dvrpsize, color_interval,
dvrpsize_interval (init_dvrp, data_output_dvrp, modules, user_data_output_dvrp).
Slicer attributes (dvrp) are set with new routine set_slicer_attributes_dvrp
and are controlled with existing parameters slicer_range_limits.
(set_slicer_attributes_dvrp)

Ocean atmosphere coupling allows to use independent precursor runs in order
to account for different spin-up times. The time when coupling has to be
started is given by new inipar parameter coupling_start_time. The precursor
ocean run has to be started using new mrun option "-y" in order to add
appendix "_O" to all output files.
(check_for_restart, check_parameters, data_output_2d, data_output_3d,
data_output_profiles, data_output_ptseries, data_output_spectra,
data_output_tseries, header, init_coupling, modules, mrun,
parin, read_var_list, surface_coupler, time_integration, write_var_list)

Polygon reduction for topography and ground plate isosurface. Reduction level
for buildings can be chosen with parameter cluster_size. (init_dvrp)

External pressure gradient (check_parameters, header, init_3d_model, modules,
parin, prognostic_equations, read_var_list, write_var_list)

New topography case 'single_street_canyon' (header, init_grid, modules, parin,
read_var_list, user_check_parameters, user_header, user_init_grid, write_var_list)

Option to predefine a target bulk velocity for conserve_volume_flow
(check_parameters, header, init_3d_model, modules, parin, read_var_list,
write_var_list)

Option for user defined 2D data output in xy cross sections at z=nzb+1
(data_output_2d, user_data_output_2d)

xy cross section output of surface heatfluxes (latent, sensible)
(average_3d_data, check_parameters, data_output_2d, modules, read_3d_binary,
sum_up_3d_data, write_3d_binary)

average_3d_data, check_for_restart, check_parameters, data_output_2d, data_output_3d, data_output_dvrp, data_output_profiles, data_output_ptseries, data_output_spectra, data_output_tseries, init_coupling, init_dvrp, init_grid, init_3d_model, header, mbuild, modules, mrun, package_parin, parin, prognostic_equations, read_3d_binary, read_var_list, subjob, surface_coupler, timestep, time_integration, user_check_parameters, user_data_output_2d, user_data_output_dvrp, user_header, user_init_grid, write_3d_binary, write_var_list

New: set_particle_attributes, set_slicer_attributes_dvrp

Changed:

lcmuk changed to lc to avoid problems with Intel compiler on sgi-ice
(poisfft)

For extended NetCDF files, the updated title attribute includes an update of
time_average_text where appropriate. (netcdf)

In case of restart runs without extension, initial profiles are not written
to NetCDF-file anymore. (data_output_profiles, modules, read_var_list, write_var_list)

Small change in formatting of the message handling routine concering the output in the
job protocoll. (message)

initializing_actions='read_data_for_recycling' renamed to 'cyclic_fill', now
independent of turbulent_inflow (check_parameters, header, init_3d_model)

2 NetCDF error numbers changed. (data_output_3d)

A Link to the website appendix_a.html is printed for further information
about the possible errors. (message)

Temperature gradient criterion for estimating the boundary layer height
replaced by the gradient criterion of Sullivan et al. (1998). (flow_statistics)

NetCDF unit attribute in timeseries output in case of statistic regions added
(netcdf)

Output of NetCDF messages with aid of message handling routine.
(check_open, close_file, data_output_2d, data_output_3d,
data_output_profiles, data_output_ptseries, data_output_spectra,
data_output_tseries, netcdf, output_particles_netcdf)

Output of messages replaced by message handling routine.
(advec_particles, advec_s_bc, buoyancy, calc_spectra, check_for_restart,
check_open, coriolis, cpu_log, data_output_2d, data_output_3d, data_output_dvrp,
data_output_profiles, data_output_spectra, fft_xy, flow_statistics, header,
init_1d_model, init_3d_model, init_dvrp, init_grid, init_particles, init_pegrid,
netcdf, parin, plant_canopy_model, poisfft_hybrid, poismg, read_3d_binary,
read_var_list, surface_coupler, temperton_fft, timestep, user_actions,
user_data_output_dvrp, user_dvrp_coltab, user_init_grid, user_init_plant_canopy,
user_parin, user_read_restart_data, user_spectra )

Maximum number of tails is calculated from maximum number of particles and
skip_particles_for_tail (init_particles)

Value of vertical_particle_advection may differ for each particle group
(advec_particles, header, modules)

First constant in array den also defined as type double. (eqn_state_seawater)

Parameter dvrp_psize moved from particles_par to dvrp_graphics_par. (package_parin)

topography_grid_convention moved from userpar to inipar (check_parameters,
header, parin, read_var_list, user_check_parameters, user_header,
user_init_grid, user_parin, write_var_list)

Default value of grid_matching changed to strict.

Adjustments for runs on lcxt4 (necessary due to an software update on CRAY) and
for coupled runs on ibmy (mrun, subjob)

advec_particles, advec_s_bc, buoyancy, calc_spectra, check_for_restart, check_open, check_parameters, close_file, coriolis, cpu_log, data_output_2d, data_output_3d, data_output_dvrp, data_output_profiles, data_output_ptseries, data_output_spectra, data_output_tseries, eqn_state_seawater, fft_xy, flow_statistics, header, init_1d_model, init_3d_model, init_dvrp, init_grid, init_particles, init_pegrid, message, mrun, netcdf, output_particles_netcdf, package_parin, parin, plant_canopy_model, poisfft, poisfft_hybrid, poismg, read_3d_binary, read_var_list, sort_particles, subjob, user_check_parameters, user_header, user_init_grid, user_parin, surface_coupler, temperton_fft, timestep, user_actions, user_data_output_dvrp, user_dvrp_coltab, user_init_grid, user_init_plant_canopy, user_parin, user_read_restart_data, user_spectra, write_var_list

Errors:

Bugfix: Initial hydrostatic pressure profile in case of ocean runs is now
calculated in 5 iteration steps. (init_ocean)

Bugfix: wrong sign in buoyancy production of ocean part in case of not using
the reference density (only in 3D routine production_e) (production_e)

Bugfix: output of averaged 2d/3d quantities requires that an avaraging
interval has been set, respective error message is included (check_parameters)

Bugfix: Output on unit 14 only if requested by write_binary.
(user_last_actions)

Bugfix to avoid zero division by km_neutral (production_e)

Bugfix for extended NetCDF files: In order to avoid 'data mode' errors if
updated attributes are larger than their original size, NF90_PUT_ATT is called
in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a
possible performance loss; an alternative strategy would be to ensure equal
attribute size in a job chain. (netcdf)

Bugfix: correction of initial volume flow for non-flat topography (init_3d_model)
Bugfix: zero initialization of arrays within buildings for 'cyclic_fill' (init_3d_model)

Bugfix: to_be_resorted => s_av for time-averaged scalars (data_output_2d, data_output_3d)

Bugfix: error in formatting the output (message)

Bugfix: avoid that ngp_2dh_s_inner becomes zero (init_3_model)

Typographical error: unit of wpt in dots_unit (modules)

Bugfix: error in check, if particles moved further than one subdomain length.
This check must not be applied for newly released particles. (advec_particles)

Bugfix: several tail counters are initialized, particle_tail_coordinates is
only written to file if its third index is > 0, arrays for tails are allocated
with a minimum size of 10 tails if there is no tail initially (init_particles,
advec_particles)

Bugfix: pressure included for profile output (check_parameters)

Bugfix: Type of count and count_rate changed to default INTEGER on NEC machines
(cpu_log)

Bugfix: output if particle time series only if particle advection is switched
on. (time_integration)

Bugfix: qsws was calculated in case of constant heatflux = .FALSE. (prandtl_fluxes)

Bugfix: averaging along z is not allowed for 2d quantities (e.g. u* and z0) (data_output_2d)

Typographical errors (netcdf)

If the inversion height calculated by the prerun is zero, inflow_damping_height
must be explicitly specified (init_3d_model)

Small bugfix concerning 3d 64bit netcdf output format (header)

Bugfix: dt_fixed removed from the restart file, because otherwise, no change
from a fixed to a variable timestep would be possible in restart runs.
(read_var_list, write_var_list)

Bugfix: initial setting of time_coupling in coupled restart runs (time_integration)

advec_particles, check_parameters, cpu_log, data_output_2d, data_output_3d, header, init_3d_model, init_particles, init_ocean, modules, netcdf, prandtl_fluxes, production_e, read_var_list, time_integration, user_last_actions, write_var_list

Property svn:keywords set to Id

File size: 39.6 KB

Line
1	SUBROUTINE init_grid
2
3	!------------------------------------------------------------------------------!
4	! Current revisions:
5	! -----------------
6	!
7	!
8	! Former revisions:
9	! -----------------
10	! $Id: init_grid.f90 392 2009-09-24 10:39:14Z franke $
11	!
12	! 274 2009-03-26 15:11:21Z heinze
13	! Output of messages replaced by message handling routine.
14	! new topography case 'single_street_canyon'
15	!
16	! 217 2008-12-09 18:00:48Z letzel
17	! +topography_grid_convention
18	!
19	! 134 2007-11-21 07:28:38Z letzel
20	! Redefine initial nzb_local as the actual total size of topography (later the
21	! extent of topography in nzb_local is reduced by 1dx at the E topography walls
22	! and by 1dy at the N topography walls to form the basis for nzb_s_inner);
23	! for consistency redefine 'single_building' case.
24	! Calculation of wall flag arrays
25	!
26	! 94 2007-06-01 15:25:22Z raasch
27	! Grid definition for ocean version
28	!
29	! 75 2007-03-22 09:54:05Z raasch
30	! storage of topography height arrays zu_s_inner and zw_s_inner,
31	! 2nd+3rd argument removed from exchange horiz
32	!
33	! 19 2007-02-23 04:53:48Z raasch
34	! Setting of nzt_diff
35	!
36	! RCS Log replace by Id keyword, revision history cleaned up
37	!
38	! Revision 1.17 2006/08/22 14:00:05 raasch
39	! +dz_max to limit vertical stretching,
40	! bugfix in index array initialization for line- or point-like topography
41	! structures
42	!
43	! Revision 1.1 1997/08/11 06:17:45 raasch
44	! Initial revision (Testversion)
45	!
46	!
47	! Description:
48	! ------------
49	! Creating grid depending constants
50	!------------------------------------------------------------------------------!
51
52	USE arrays_3d
53	USE control_parameters
54	USE grid_variables
55	USE indices
56	USE pegrid
57
58	IMPLICIT NONE
59
60	INTEGER :: bh, blx, bly, bxl, bxr, byn, bys, ch, cwx, cwy, cxl, cxr, cyn, &
61	cys, gls, i, inc, i_center, j, j_center, k, l, nxl_l, nxr_l, &
62	nyn_l, nys_l, nzb_si, nzt_l, vi
63
64	INTEGER, DIMENSION(:), ALLOCATABLE :: vertical_influence
65
66	INTEGER, DIMENSION(:,:), ALLOCATABLE :: corner_nl, corner_nr, corner_sl, &
67	corner_sr, wall_l, wall_n, wall_r,&
68	wall_s, nzb_local, nzb_tmp
69
70	REAL :: dx_l, dy_l, dz_stretched
71
72	REAL, DIMENSION(0:ny,0:nx) :: topo_height
73
74	REAL, DIMENSION(:,:,:), ALLOCATABLE :: distance
75
76	!
77	!-- Allocate grid arrays
78	ALLOCATE( ddzu(1:nzt+1), ddzw(1:nzt+1), dd2zu(1:nzt), dzu(1:nzt+1), &
79	dzw(1:nzt+1), l_grid(1:nzt), zu(0:nzt+1), zw(0:nzt+1) )
80
81	!
82	!-- Compute height of u-levels from constant grid length and dz stretch factors
83	IF ( dz == -1.0 ) THEN
84	message_string = 'missing dz'
85	CALL message( 'init_grid', 'PA0200', 1, 2, 0, 6, 0 )
86	ELSEIF ( dz <= 0.0 ) THEN
87	WRITE( message_string, * ) 'dz=',dz,' <= 0.0'
88	CALL message( 'init_grid', 'PA0201', 1, 2, 0, 6, 0 )
89	ENDIF
90
91	!
92	!-- Define the vertical grid levels
93	IF ( .NOT. ocean ) THEN
94	!
95	!-- Grid for atmosphere with surface at z=0 (k=0, w-grid).
96	!-- Since the w-level lies on the surface, the first u-level (staggered!)
97	!-- lies below the surface (used for "mirror" boundary condition).
98	!-- The first u-level above the surface corresponds to the top of the
99	!-- Prandtl-layer.
100	zu(0) = - dz * 0.5
101	zu(1) = dz * 0.5
102
103	dz_stretch_level_index = nzt+1
104	dz_stretched = dz
105	DO k = 2, nzt+1
106	IF ( dz_stretch_level <= zu(k-1) .AND. dz_stretched < dz_max ) THEN
107	dz_stretched = dz_stretched * dz_stretch_factor
108	dz_stretched = MIN( dz_stretched, dz_max )
109	IF ( dz_stretch_level_index == nzt+1 ) dz_stretch_level_index = k-1
110	ENDIF
111	zu(k) = zu(k-1) + dz_stretched
112	ENDDO
113
114	!
115	!-- Compute the w-levels. They are always staggered half-way between the
116	!-- corresponding u-levels. The top w-level is extrapolated linearly.
117	zw(0) = 0.0
118	DO k = 1, nzt
119	zw(k) = ( zu(k) + zu(k+1) ) * 0.5
120	ENDDO
121	zw(nzt+1) = zw(nzt) + 2.0 * ( zu(nzt+1) - zw(nzt) )
122
123	ELSE
124	!
125	!-- Grid for ocean with solid surface at z=0 (k=0, w-grid). The free water
126	!-- surface is at k=nzt (w-grid).
127	!-- Since the w-level lies always on the surface, the first/last u-level
128	!-- (staggered!) lies below the bottom surface / above the free surface.
129	!-- It is used for "mirror" boundary condition.
130	!-- The first u-level above the bottom surface corresponds to the top of the
131	!-- Prandtl-layer.
132	zu(nzt+1) = dz * 0.5
133	zu(nzt) = - dz * 0.5
134
135	dz_stretch_level_index = 0
136	dz_stretched = dz
137	DO k = nzt-1, 0, -1
138	IF ( dz_stretch_level <= ABS( zu(k+1) ) .AND. &
139	dz_stretched < dz_max ) THEN
140	dz_stretched = dz_stretched * dz_stretch_factor
141	dz_stretched = MIN( dz_stretched, dz_max )
142	IF ( dz_stretch_level_index == 0 ) dz_stretch_level_index = k+1
143	ENDIF
144	zu(k) = zu(k+1) - dz_stretched
145	ENDDO
146
147	!
148	!-- Compute the w-levels. They are always staggered half-way between the
149	!-- corresponding u-levels.
150	!-- The top w-level (nzt+1) is not used but set for consistency, since
151	!-- w and all scalar variables are defined up tp nzt+1.
152	zw(nzt+1) = dz
153	zw(nzt) = 0.0
154	DO k = 0, nzt
155	zw(k) = ( zu(k) + zu(k+1) ) * 0.5
156	ENDDO
157
158	ENDIF
159
160	!
161	!-- Compute grid lengths.
162	DO k = 1, nzt+1
163	dzu(k) = zu(k) - zu(k-1)
164	ddzu(k) = 1.0 / dzu(k)
165	dzw(k) = zw(k) - zw(k-1)
166	ddzw(k) = 1.0 / dzw(k)
167	ENDDO
168
169	DO k = 1, nzt
170	dd2zu(k) = 1.0 / ( dzu(k) + dzu(k+1) )
171	ENDDO
172
173	!
174	!-- In case of multigrid method, compute grid lengths and grid factors for the
175	!-- grid levels
176	IF ( psolver == 'multigrid' ) THEN
177
178	ALLOCATE( ddx2_mg(maximum_grid_level), ddy2_mg(maximum_grid_level), &
179	dzu_mg(nzb+1:nzt+1,maximum_grid_level), &
180	dzw_mg(nzb+1:nzt+1,maximum_grid_level), &
181	f1_mg(nzb+1:nzt,maximum_grid_level), &
182	f2_mg(nzb+1:nzt,maximum_grid_level), &
183	f3_mg(nzb+1:nzt,maximum_grid_level) )
184
185	dzu_mg(:,maximum_grid_level) = dzu
186	dzw_mg(:,maximum_grid_level) = dzw
187	nzt_l = nzt
188	DO l = maximum_grid_level-1, 1, -1
189	dzu_mg(nzb+1,l) = 2.0 * dzu_mg(nzb+1,l+1)
190	dzw_mg(nzb+1,l) = 2.0 * dzw_mg(nzb+1,l+1)
191	nzt_l = nzt_l / 2
192	DO k = 2, nzt_l+1
193	dzu_mg(k,l) = dzu_mg(2k-2,l+1) + dzu_mg(2k-1,l+1)
194	dzw_mg(k,l) = dzw_mg(2k-2,l+1) + dzw_mg(2k-1,l+1)
195	ENDDO
196	ENDDO
197
198	nzt_l = nzt
199	dx_l = dx
200	dy_l = dy
201	DO l = maximum_grid_level, 1, -1
202	ddx2_mg(l) = 1.0 / dx_l**2
203	ddy2_mg(l) = 1.0 / dy_l**2
204	DO k = nzb+1, nzt_l
205	f2_mg(k,l) = 1.0 / ( dzu_mg(k+1,l) * dzw_mg(k,l) )
206	f3_mg(k,l) = 1.0 / ( dzu_mg(k,l) * dzw_mg(k,l) )
207	f1_mg(k,l) = 2.0 * ( ddx2_mg(l) + ddy2_mg(l) ) + &
208	f2_mg(k,l) + f3_mg(k,l)
209	ENDDO
210	nzt_l = nzt_l / 2
211	dx_l = dx_l * 2.0
212	dy_l = dy_l * 2.0
213	ENDDO
214
215	ENDIF
216
217	!
218	!-- Compute the reciprocal values of the horizontal grid lengths.
219	ddx = 1.0 / dx
220	ddy = 1.0 / dy
221	dx2 = dx * dx
222	dy2 = dy * dy
223	ddx2 = 1.0 / dx2
224	ddy2 = 1.0 / dy2
225
226	!
227	!-- Compute the grid-dependent mixing length.
228	DO k = 1, nzt
229	l_grid(k) = ( dx * dy * dzw(k) )**0.33333333333333
230	ENDDO
231
232	!
233	!-- Allocate outer and inner index arrays for topography and set
234	!-- defaults.
235	!-- nzb_local has to contain additional layers of ghost points for calculating
236	!-- the flag arrays needed for the multigrid method
237	gls = 2**( maximum_grid_level )
238	ALLOCATE( corner_nl(nys:nyn,nxl:nxr), corner_nr(nys:nyn,nxl:nxr), &
239	corner_sl(nys:nyn,nxl:nxr), corner_sr(nys:nyn,nxl:nxr), &
240	nzb_local(-gls:ny+gls,-gls:nx+gls), nzb_tmp(-1:ny+1,-1:nx+1), &
241	wall_l(nys:nyn,nxl:nxr), wall_n(nys:nyn,nxl:nxr), &
242	wall_r(nys:nyn,nxl:nxr), wall_s(nys:nyn,nxl:nxr) )
243	ALLOCATE( fwxm(nys-1:nyn+1,nxl-1:nxr+1), fwxp(nys-1:nyn+1,nxl-1:nxr+1), &
244	fwym(nys-1:nyn+1,nxl-1:nxr+1), fwyp(nys-1:nyn+1,nxl-1:nxr+1), &
245	fxm(nys-1:nyn+1,nxl-1:nxr+1), fxp(nys-1:nyn+1,nxl-1:nxr+1), &
246	fym(nys-1:nyn+1,nxl-1:nxr+1), fyp(nys-1:nyn+1,nxl-1:nxr+1), &
247	nzb_s_inner(nys-1:nyn+1,nxl-1:nxr+1), &
248	nzb_s_outer(nys-1:nyn+1,nxl-1:nxr+1), &
249	nzb_u_inner(nys-1:nyn+1,nxl-1:nxr+1), &
250	nzb_u_outer(nys-1:nyn+1,nxl-1:nxr+1), &
251	nzb_v_inner(nys-1:nyn+1,nxl-1:nxr+1), &
252	nzb_v_outer(nys-1:nyn+1,nxl-1:nxr+1), &
253	nzb_w_inner(nys-1:nyn+1,nxl-1:nxr+1), &
254	nzb_w_outer(nys-1:nyn+1,nxl-1:nxr+1), &
255	nzb_diff_s_inner(nys-1:nyn+1,nxl-1:nxr+1), &
256	nzb_diff_s_outer(nys-1:nyn+1,nxl-1:nxr+1), &
257	nzb_diff_u(nys-1:nyn+1,nxl-1:nxr+1), &
258	nzb_diff_v(nys-1:nyn+1,nxl-1:nxr+1), &
259	nzb_2d(nys-1:nyn+1,nxl-1:nxr+1), &
260	wall_e_x(nys-1:nyn+1,nxl-1:nxr+1), &
261	wall_e_y(nys-1:nyn+1,nxl-1:nxr+1), &
262	wall_u(nys-1:nyn+1,nxl-1:nxr+1), &
263	wall_v(nys-1:nyn+1,nxl-1:nxr+1), &
264	wall_w_x(nys-1:nyn+1,nxl-1:nxr+1), &
265	wall_w_y(nys-1:nyn+1,nxl-1:nxr+1) )
266
267	ALLOCATE( l_wall(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
268
269	nzb_s_inner = nzb; nzb_s_outer = nzb
270	nzb_u_inner = nzb; nzb_u_outer = nzb
271	nzb_v_inner = nzb; nzb_v_outer = nzb
272	nzb_w_inner = nzb; nzb_w_outer = nzb
273
274	!
275	!-- Define vertical gridpoint from (or to) which on the usual finite difference
276	!-- form (which does not use surface fluxes) is applied
277	IF ( prandtl_layer .OR. use_surface_fluxes ) THEN
278	nzb_diff = nzb + 2
279	ELSE
280	nzb_diff = nzb + 1
281	ENDIF
282	IF ( use_top_fluxes ) THEN
283	nzt_diff = nzt - 1
284	ELSE
285	nzt_diff = nzt
286	ENDIF
287
288	nzb_diff_s_inner = nzb_diff; nzb_diff_s_outer = nzb_diff
289	nzb_diff_u = nzb_diff; nzb_diff_v = nzb_diff
290
291	wall_e_x = 0.0; wall_e_y = 0.0; wall_u = 0.0; wall_v = 0.0
292	wall_w_x = 0.0; wall_w_y = 0.0
293	fwxp = 1.0; fwxm = 1.0; fwyp = 1.0; fwym = 1.0
294	fxp = 1.0; fxm = 1.0; fyp = 1.0; fym = 1.0
295
296	!
297	!-- Initialize near-wall mixing length l_wall only in the vertical direction
298	!-- for the moment,
299	!-- multiplication with wall_adjustment_factor near the end of this routine
300	l_wall(nzb,:,:) = l_grid(1)
301	DO k = nzb+1, nzt
302	l_wall(k,:,:) = l_grid(k)
303	ENDDO
304	l_wall(nzt+1,:,:) = l_grid(nzt)
305
306	ALLOCATE ( vertical_influence(nzb:nzt) )
307	DO k = 1, nzt
308	vertical_influence(k) = MIN ( INT( l_grid(k) / &
309	( wall_adjustment_factor * dzw(k) ) + 0.5 ), nzt - k )
310	ENDDO
311
312	DO k = 1, MAXVAL( nzb_s_inner )
313	IF ( l_grid(k) > 1.5 * dx * wall_adjustment_factor .OR. &
314	l_grid(k) > 1.5 * dy * wall_adjustment_factor ) THEN
315	WRITE( message_string, * ) 'grid anisotropy exceeds ', &
316	'threshold given by only local', &
317	' &horizontal reduction of near_wall ', &
318	'mixing length l_wall', &
319	' &starting from height level k = ', k, '.'
320	CALL message( 'init_grid', 'PA0202', 0, 1, 0, 6, 0 )
321	EXIT
322	ENDIF
323	ENDDO
324	vertical_influence(0) = vertical_influence(1)
325
326	DO i = nxl-1, nxr+1
327	DO j = nys-1, nyn+1
328	DO k = nzb_s_inner(j,i) + 1, &
329	nzb_s_inner(j,i) + vertical_influence(nzb_s_inner(j,i))
330	l_wall(k,j,i) = zu(k) - zw(nzb_s_inner(j,i))
331	ENDDO
332	ENDDO
333	ENDDO
334
335	!
336	!-- Set outer and inner index arrays for non-flat topography.
337	!-- Here consistency checks concerning domain size and periodicity are
338	!-- necessary.
339	!-- Within this SELECT CASE structure only nzb_local is initialized
340	!-- individually depending on the chosen topography type, all other index
341	!-- arrays are initialized further below.
342	SELECT CASE ( TRIM( topography ) )
343
344	CASE ( 'flat' )
345	!
346	!-- No actions necessary
347
348	CASE ( 'single_building' )
349	!
350	!-- Single rectangular building, by default centered in the middle of the
351	!-- total domain
352	blx = NINT( building_length_x / dx )
353	bly = NINT( building_length_y / dy )
354	bh = NINT( building_height / dz )
355
356	IF ( building_wall_left == 9999999.9 ) THEN
357	building_wall_left = ( nx + 1 - blx ) / 2 * dx
358	ENDIF
359	bxl = NINT( building_wall_left / dx )
360	bxr = bxl + blx
361
362	IF ( building_wall_south == 9999999.9 ) THEN
363	building_wall_south = ( ny + 1 - bly ) / 2 * dy
364	ENDIF
365	bys = NINT( building_wall_south / dy )
366	byn = bys + bly
367
368	!
369	!-- Building size has to meet some requirements
370	IF ( ( bxl < 1 ) .OR. ( bxr > nx-1 ) .OR. ( bxr < bxl+3 ) .OR. &
371	( bys < 1 ) .OR. ( byn > ny-1 ) .OR. ( byn < bys+3 ) ) THEN
372	WRITE( message_string, * ) 'inconsistent building parameters:', &
373	'& bxl=', bxl, 'bxr=', bxr, 'bys=', bys, &
374	'byn=', byn, 'nx=', nx, 'ny=', ny
375	CALL message( 'init_grid', 'PA0203', 1, 2, 0, 6, 0 )
376	ENDIF
377
378	!
379	!-- Define the building.
380	nzb_local = 0
381	nzb_local(bys:byn,bxl:bxr) = bh
382
383	CASE ( 'single_street_canyon' )
384	!
385	!-- Single quasi-2D street canyon of infinite length in x or y direction.
386	!-- The canyon is centered in the other direction by default.
387	IF ( canyon_width_x /= 9999999.9 ) THEN
388	!
389	!-- Street canyon in y direction
390	cwx = NINT( canyon_width_x / dx )
391	IF ( canyon_wall_left == 9999999.9 ) THEN
392	canyon_wall_left = ( nx + 1 - cwx ) / 2 * dx
393	ENDIF
394	cxl = NINT( canyon_wall_left / dx )
395	cxr = cxl + cwx
396
397	ELSEIF ( canyon_width_y /= 9999999.9 ) THEN
398	!
399	!-- Street canyon in x direction
400	cwy = NINT( canyon_width_y / dy )
401	IF ( canyon_wall_south == 9999999.9 ) THEN
402	canyon_wall_south = ( ny + 1 - cwy ) / 2 * dy
403	ENDIF
404	cys = NINT( canyon_wall_south / dy )
405	cyn = cys + cwy
406
407	ELSE
408
409	message_string = 'no street canyon width given'
410	CALL message( 'init_grid', 'PA0204', 1, 2, 0, 6, 0 )
411
412	ENDIF
413
414	ch = NINT( canyon_height / dz )
415	dp_level_ind_b = ch
416	!
417	!-- Street canyon size has to meet some requirements
418	IF ( canyon_width_x /= 9999999.9 ) THEN
419	IF ( ( cxl < 1 ) .OR. ( cxr > nx-1 ) .OR. ( cwx < 3 ) .OR. &
420	( ch < 3 ) ) THEN
421	WRITE( message_string, * ) 'inconsistent canyon parameters:', &
422	'&cxl=', cxl, 'cxr=', cxr, &
423	'cwx=', cwx, &
424	'ch=', ch, 'nx=', nx, 'ny=', ny
425	CALL message( 'init_grid', 'PA0205', 1, 2, 0, 6, 0 )
426	ENDIF
427	ELSEIF ( canyon_width_y /= 9999999.9 ) THEN
428	IF ( ( cys < 1 ) .OR. ( cyn > ny-1 ) .OR. ( cwy < 3 ) .OR. &
429	( ch < 3 ) ) THEN
430	WRITE( message_string, * ) 'inconsistent canyon parameters:', &
431	'&cys=', cys, 'cyn=', cyn, &
432	'cwy=', cwy, &
433	'ch=', ch, 'nx=', nx, 'ny=', ny
434	CALL message( 'init_grid', 'PA0206', 1, 2, 0, 6, 0 )
435	ENDIF
436	ENDIF
437	IF ( canyon_width_x /= 9999999.9 .AND. canyon_width_y /= 9999999.9 ) &
438	THEN
439	message_string = 'inconsistent canyon parameters:' // &
440	'&street canyon can only be oriented' // &
441	'&either in x- or in y-direction'
442	CALL message( 'init_grid', 'PA0207', 1, 2, 0, 6, 0 )
443	ENDIF
444
445	nzb_local = ch
446	IF ( canyon_width_x /= 9999999.9 ) THEN
447	nzb_local(:,cxl+1:cxr-1) = 0
448	ELSEIF ( canyon_width_y /= 9999999.9 ) THEN
449	nzb_local(cys+1:cyn-1,:) = 0
450	ENDIF
451
452	CASE ( 'read_from_file' )
453	!
454	!-- Arbitrary irregular topography data in PALM format (exactly matching
455	!-- the grid size and total domain size)
456	OPEN( 90, FILE='TOPOGRAPHY_DATA', STATUS='OLD', FORM='FORMATTED', &
457	ERR=10 )
458	DO j = ny, 0, -1
459	READ( 90, *, ERR=11, END=11 ) ( topo_height(j,i), i = 0, nx )
460	ENDDO
461	!
462	!-- Calculate the index height of the topography
463	DO i = 0, nx
464	DO j = 0, ny
465	nzb_local(j,i) = NINT( topo_height(j,i) / dz )
466	ENDDO
467	ENDDO
468	!
469	!-- Add cyclic boundaries (additional layers are for calculating flag
470	!-- arrays needed for the multigrid sover)
471	nzb_local(-gls:-1,0:nx) = nzb_local(ny-gls+1:ny,0:nx)
472	nzb_local(ny+1:ny+gls,0:nx) = nzb_local(0:gls-1,0:nx)
473	nzb_local(:,-gls:-1) = nzb_local(:,nx-gls+1:nx)
474	nzb_local(:,nx+1:nx+gls) = nzb_local(:,0:gls-1)
475
476	GOTO 12
477
478	10 message_string = 'file TOPOGRAPHY_DATA does not exist'
479	CALL message( 'init_grid', 'PA0208', 1, 2, 0, 6, 0 )
480
481	11 message_string = 'errors in file TOPOGRAPHY_DATA'
482	CALL message( 'init_grid', 'PA0209', 1, 2, 0, 6, 0 )
483
484	12 CLOSE( 90 )
485
486	CASE DEFAULT
487	!
488	!-- The DEFAULT case is reached either if the parameter topography
489	!-- contains a wrong character string or if the user has defined a special
490	!-- case in the user interface. There, the subroutine user_init_grid
491	!-- checks which of these two conditions applies.
492	CALL user_init_grid( gls, nzb_local )
493
494	END SELECT
495
496	!
497	!-- Test output of nzb_local -1:ny+1,-1:nx+1
498	! WRITE (9,) ' nzb_local *'
499	! DO j = ny+1, -1, -1
500	! WRITE (9,'(194(1X,I2))') ( nzb_local(j,i), i = -1, nx+1 )
501	! ENDDO
502
503	!
504	!-- Consistency checks and index array initialization are only required for
505	!-- non-flat topography, also the initialization of topography height arrays
506	!-- zu_s_inner and zw_w_inner
507	IF ( TRIM( topography ) /= 'flat' ) THEN
508
509	!
510	!-- Consistency checks
511	IF ( MINVAL( nzb_local ) < 0 .OR. MAXVAL( nzb_local ) > nz + 1 ) THEN
512	WRITE( message_string, * ) 'nzb_local values are outside the', &
513	'model domain', &
514	'&MINVAL( nzb_local ) = ', MINVAL(nzb_local), &
515	'&MAXVAL( nzb_local ) = ', MAXVAL(nzb_local)
516	CALL message( 'init_grid', 'PA0210', 1, 2, 0, 6, 0 )
517	ENDIF
518
519	IF ( bc_lr == 'cyclic' ) THEN
520	IF ( ANY( nzb_local(:,-1) /= nzb_local(:,nx) ) .OR. &
521	ANY( nzb_local(:,0) /= nzb_local(:,nx+1) ) ) THEN
522	message_string = 'nzb_local does not fulfill cyclic' // &
523	' boundary condition in x-direction'
524	CALL message( 'init_grid', 'PA0211', 1, 2, 0, 6, 0 )
525	ENDIF
526	ENDIF
527	IF ( bc_ns == 'cyclic' ) THEN
528	IF ( ANY( nzb_local(-1,:) /= nzb_local(ny,:) ) .OR. &
529	ANY( nzb_local(0,:) /= nzb_local(ny+1,:) ) ) THEN
530	message_string = 'nzb_local does not fulfill cyclic' // &
531	' boundary condition in y-direction'
532	CALL message( 'init_grid', 'PA0212', 1, 2, 0, 6, 0 )
533	ENDIF
534	ENDIF
535
536	IF ( topography_grid_convention == 'cell_edge' ) THEN
537	!
538	!-- The array nzb_local as defined using the 'cell_edge' convention
539	!-- describes the actual total size of topography which is defined at the
540	!-- cell edges where u=0 on the topography walls in x-direction and v=0
541	!-- on the topography walls in y-direction. However, PALM uses individual
542	!-- arrays nzb_u\|v\|w\|s_inner\|outer that are based on nzb_s_inner.
543	!-- Therefore, the extent of topography in nzb_local is now reduced by
544	!-- 1dx at the E topography walls and by 1dy at the N topography walls
545	!-- to form the basis for nzb_s_inner.
546	DO j = -gls, ny + gls
547	DO i = -gls, nx
548	nzb_local(j,i) = MIN( nzb_local(j,i), nzb_local(j,i+1) )
549	ENDDO
550	ENDDO
551	!-- apply cyclic boundary conditions in x-direction
552	!(ist das erforderlich? Ursache von Seung Bus Fehler?)
553	nzb_local(:,nx+1:nx+gls) = nzb_local(:,0:gls-1)
554	DO i = -gls, nx + gls
555	DO j = -gls, ny
556	nzb_local(j,i) = MIN( nzb_local(j,i), nzb_local(j+1,i) )
557	ENDDO
558	ENDDO
559	!-- apply cyclic boundary conditions in y-direction
560	!(ist das erforderlich? Ursache von Seung Bus Fehler?)
561	nzb_local(ny+1:ny+gls,:) = nzb_local(0:gls-1,:)
562	ENDIF
563
564	!
565	!-- Initialize index arrays nzb_s_inner and nzb_w_inner
566	nzb_s_inner = nzb_local(nys-1:nyn+1,nxl-1:nxr+1)
567	nzb_w_inner = nzb_local(nys-1:nyn+1,nxl-1:nxr+1)
568
569	!
570	!-- Initialize remaining index arrays:
571	!-- first pre-initialize them with nzb_s_inner...
572	nzb_u_inner = nzb_s_inner
573	nzb_u_outer = nzb_s_inner
574	nzb_v_inner = nzb_s_inner
575	nzb_v_outer = nzb_s_inner
576	nzb_w_outer = nzb_s_inner
577	nzb_s_outer = nzb_s_inner
578
579	!
580	!-- ...then extend pre-initialized arrays in their according directions
581	!-- based on nzb_local using nzb_tmp as a temporary global index array
582
583	!
584	!-- nzb_s_outer:
585	!-- extend nzb_local east-/westwards first, then north-/southwards
586	nzb_tmp = nzb_local(-1:ny+1,-1:nx+1)
587	DO j = -1, ny + 1
588	DO i = 0, nx
589	nzb_tmp(j,i) = MAX( nzb_local(j,i-1), nzb_local(j,i), &
590	nzb_local(j,i+1) )
591	ENDDO
592	ENDDO
593	DO i = nxl, nxr
594	DO j = nys, nyn
595	nzb_s_outer(j,i) = MAX( nzb_tmp(j-1,i), nzb_tmp(j,i), &
596	nzb_tmp(j+1,i) )
597	ENDDO
598	!
599	!-- non-cyclic boundary conditions (overwritten by call of
600	!-- exchange_horiz_2d_int below in case of cyclic boundary conditions)
601	IF ( nys == 0 ) THEN
602	j = -1
603	nzb_s_outer(j,i) = MAX( nzb_tmp(j+1,i), nzb_tmp(j,i) )
604	ENDIF
605	IF ( nys == ny ) THEN
606	j = ny + 1
607	nzb_s_outer(j,i) = MAX( nzb_tmp(j-1,i), nzb_tmp(j,i) )
608	ENDIF
609	ENDDO
610	!
611	!-- nzb_w_outer:
612	!-- identical to nzb_s_outer
613	nzb_w_outer = nzb_s_outer
614
615	!
616	!-- nzb_u_inner:
617	!-- extend nzb_local rightwards only
618	nzb_tmp = nzb_local(-1:ny+1,-1:nx+1)
619	DO j = -1, ny + 1
620	DO i = 0, nx + 1
621	nzb_tmp(j,i) = MAX( nzb_local(j,i-1), nzb_local(j,i) )
622	ENDDO
623	ENDDO
624	nzb_u_inner = nzb_tmp(nys-1:nyn+1,nxl-1:nxr+1)
625
626	!
627	!-- nzb_u_outer:
628	!-- extend current nzb_tmp (nzb_u_inner) north-/southwards
629	DO i = nxl, nxr
630	DO j = nys, nyn
631	nzb_u_outer(j,i) = MAX( nzb_tmp(j-1,i), nzb_tmp(j,i), &
632	nzb_tmp(j+1,i) )
633	ENDDO
634	!
635	!-- non-cyclic boundary conditions (overwritten by call of
636	!-- exchange_horiz_2d_int below in case of cyclic boundary conditions)
637	IF ( nys == 0 ) THEN
638	j = -1
639	nzb_u_outer(j,i) = MAX( nzb_tmp(j+1,i), nzb_tmp(j,i) )
640	ENDIF
641	IF ( nys == ny ) THEN
642	j = ny + 1
643	nzb_u_outer(j,i) = MAX( nzb_tmp(j-1,i), nzb_tmp(j,i) )
644	ENDIF
645	ENDDO
646
647	!
648	!-- nzb_v_inner:
649	!-- extend nzb_local northwards only
650	nzb_tmp = nzb_local(-1:ny+1,-1:nx+1)
651	DO i = -1, nx + 1
652	DO j = 0, ny + 1
653	nzb_tmp(j,i) = MAX( nzb_local(j-1,i), nzb_local(j,i) )
654	ENDDO
655	ENDDO
656	nzb_v_inner = nzb_tmp(nys-1:nyn+1,nxl-1:nxr+1)
657
658	!
659	!-- nzb_v_outer:
660	!-- extend current nzb_tmp (nzb_v_inner) right-/leftwards
661	DO j = nys, nyn
662	DO i = nxl, nxr
663	nzb_v_outer(j,i) = MAX( nzb_tmp(j,i-1), nzb_tmp(j,i), &
664	nzb_tmp(j,i+1) )
665	ENDDO
666	!
667	!-- non-cyclic boundary conditions (overwritten by call of
668	!-- exchange_horiz_2d_int below in case of cyclic boundary conditions)
669	IF ( nxl == 0 ) THEN
670	i = -1
671	nzb_v_outer(j,i) = MAX( nzb_tmp(j,i+1), nzb_tmp(j,i) )
672	ENDIF
673	IF ( nxr == nx ) THEN
674	i = nx + 1
675	nzb_v_outer(j,i) = MAX( nzb_tmp(j,i-1), nzb_tmp(j,i) )
676	ENDIF
677	ENDDO
678
679	!
680	!-- Exchange of lateral boundary values (parallel computers) and cyclic
681	!-- boundary conditions, if applicable.
682	!-- Since nzb_s_inner and nzb_w_inner are derived directly from nzb_local
683	!-- they do not require exchange and are not included here.
684	CALL exchange_horiz_2d_int( nzb_u_inner )
685	CALL exchange_horiz_2d_int( nzb_u_outer )
686	CALL exchange_horiz_2d_int( nzb_v_inner )
687	CALL exchange_horiz_2d_int( nzb_v_outer )
688	CALL exchange_horiz_2d_int( nzb_w_outer )
689	CALL exchange_horiz_2d_int( nzb_s_outer )
690
691	!
692	!-- Allocate and set the arrays containing the topography height
693	IF ( myid == 0 ) THEN
694
695	ALLOCATE( zu_s_inner(0:nx+1,0:ny+1), zw_w_inner(0:nx+1,0:ny+1) )
696
697	DO i = 0, nx + 1
698	DO j = 0, ny + 1
699	zu_s_inner(i,j) = zu(nzb_local(j,i))
700	zw_w_inner(i,j) = zw(nzb_local(j,i))
701	ENDDO
702	ENDDO
703
704	ENDIF
705
706	ENDIF
707
708	!
709	!-- Preliminary: to be removed after completion of the topography code!
710	!-- Set the former default k index arrays nzb_2d
711	nzb_2d = nzb
712
713	!
714	!-- Set the individual index arrays which define the k index from which on
715	!-- the usual finite difference form (which does not use surface fluxes) is
716	!-- applied
717	IF ( prandtl_layer .OR. use_surface_fluxes ) THEN
718	nzb_diff_u = nzb_u_inner + 2
719	nzb_diff_v = nzb_v_inner + 2
720	nzb_diff_s_inner = nzb_s_inner + 2
721	nzb_diff_s_outer = nzb_s_outer + 2
722	ELSE
723	nzb_diff_u = nzb_u_inner + 1
724	nzb_diff_v = nzb_v_inner + 1
725	nzb_diff_s_inner = nzb_s_inner + 1
726	nzb_diff_s_outer = nzb_s_outer + 1
727	ENDIF
728
729	!
730	!-- Calculation of wall switches and factors required by diffusion_u/v.f90 and
731	!-- for limitation of near-wall mixing length l_wall further below
732	corner_nl = 0
733	corner_nr = 0
734	corner_sl = 0
735	corner_sr = 0
736	wall_l = 0
737	wall_n = 0
738	wall_r = 0
739	wall_s = 0
740
741	DO i = nxl, nxr
742	DO j = nys, nyn
743	!
744	!-- u-component
745	IF ( nzb_u_outer(j,i) > nzb_u_outer(j+1,i) ) THEN
746	wall_u(j,i) = 1.0 ! north wall (location of adjacent fluid)
747	fym(j,i) = 0.0
748	fyp(j,i) = 1.0
749	ELSEIF ( nzb_u_outer(j,i) > nzb_u_outer(j-1,i) ) THEN
750	wall_u(j,i) = 1.0 ! south wall (location of adjacent fluid)
751	fym(j,i) = 1.0
752	fyp(j,i) = 0.0
753	ENDIF
754	!
755	!-- v-component
756	IF ( nzb_v_outer(j,i) > nzb_v_outer(j,i+1) ) THEN
757	wall_v(j,i) = 1.0 ! rigth wall (location of adjacent fluid)
758	fxm(j,i) = 0.0
759	fxp(j,i) = 1.0
760	ELSEIF ( nzb_v_outer(j,i) > nzb_v_outer(j,i-1) ) THEN
761	wall_v(j,i) = 1.0 ! left wall (location of adjacent fluid)
762	fxm(j,i) = 1.0
763	fxp(j,i) = 0.0
764	ENDIF
765	!
766	!-- w-component, also used for scalars, separate arrays for shear
767	!-- production of tke
768	IF ( nzb_w_outer(j,i) > nzb_w_outer(j+1,i) ) THEN
769	wall_e_y(j,i) = 1.0 ! north wall (location of adjacent fluid)
770	wall_w_y(j,i) = 1.0
771	fwym(j,i) = 0.0
772	fwyp(j,i) = 1.0
773	ELSEIF ( nzb_w_outer(j,i) > nzb_w_outer(j-1,i) ) THEN
774	wall_e_y(j,i) = -1.0 ! south wall (location of adjacent fluid)
775	wall_w_y(j,i) = 1.0
776	fwym(j,i) = 1.0
777	fwyp(j,i) = 0.0
778	ENDIF
779	IF ( nzb_w_outer(j,i) > nzb_w_outer(j,i+1) ) THEN
780	wall_e_x(j,i) = 1.0 ! right wall (location of adjacent fluid)
781	wall_w_x(j,i) = 1.0
782	fwxm(j,i) = 0.0
783	fwxp(j,i) = 1.0
784	ELSEIF ( nzb_w_outer(j,i) > nzb_w_outer(j,i-1) ) THEN
785	wall_e_x(j,i) = -1.0 ! left wall (location of adjacent fluid)
786	wall_w_x(j,i) = 1.0
787	fwxm(j,i) = 1.0
788	fwxp(j,i) = 0.0
789	ENDIF
790	!
791	!-- Wall and corner locations inside buildings for limitation of
792	!-- near-wall mixing length l_wall
793	IF ( nzb_s_inner(j,i) > nzb_s_inner(j+1,i) ) THEN
794
795	wall_n(j,i) = nzb_s_inner(j+1,i) + 1 ! North wall
796
797	IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i-1) ) THEN
798	corner_nl(j,i) = MAX( nzb_s_inner(j+1,i), & ! Northleft corner
799	nzb_s_inner(j,i-1) ) + 1
800	ENDIF
801
802	IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i+1) ) THEN
803	corner_nr(j,i) = MAX( nzb_s_inner(j+1,i), & ! Northright corner
804	nzb_s_inner(j,i+1) ) + 1
805	ENDIF
806
807	ENDIF
808
809	IF ( nzb_s_inner(j,i) > nzb_s_inner(j-1,i) ) THEN
810
811	wall_s(j,i) = nzb_s_inner(j-1,i) + 1 ! South wall
812	IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i-1) ) THEN
813	corner_sl(j,i) = MAX( nzb_s_inner(j-1,i), & ! Southleft corner
814	nzb_s_inner(j,i-1) ) + 1
815	ENDIF
816
817	IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i+1) ) THEN
818	corner_sr(j,i) = MAX( nzb_s_inner(j-1,i), & ! Southright corner
819	nzb_s_inner(j,i+1) ) + 1
820	ENDIF
821
822	ENDIF
823
824	IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i-1) ) THEN
825	wall_l(j,i) = nzb_s_inner(j,i-1) + 1 ! Left wall
826	ENDIF
827
828	IF ( nzb_s_inner(j,i) > nzb_s_inner(j,i+1) ) THEN
829	wall_r(j,i) = nzb_s_inner(j,i+1) + 1 ! Right wall
830	ENDIF
831
832	ENDDO
833	ENDDO
834
835	!
836	!-- Calculate wall flag arrays for the multigrid method
837	IF ( psolver == 'multigrid' ) THEN
838	!
839	!-- Gridpoint increment of the current level
840	inc = 1
841
842	DO l = maximum_grid_level, 1 , -1
843
844	nxl_l = nxl_mg(l)
845	nxr_l = nxr_mg(l)
846	nys_l = nys_mg(l)
847	nyn_l = nyn_mg(l)
848	nzt_l = nzt_mg(l)
849
850	!
851	!-- Assign the flag level to be calculated
852	SELECT CASE ( l )
853	CASE ( 1 )
854	flags => wall_flags_1
855	CASE ( 2 )
856	flags => wall_flags_2
857	CASE ( 3 )
858	flags => wall_flags_3
859	CASE ( 4 )
860	flags => wall_flags_4
861	CASE ( 5 )
862	flags => wall_flags_5
863	CASE ( 6 )
864	flags => wall_flags_6
865	CASE ( 7 )
866	flags => wall_flags_7
867	CASE ( 8 )
868	flags => wall_flags_8
869	CASE ( 9 )
870	flags => wall_flags_9
871	CASE ( 10 )
872	flags => wall_flags_10
873	END SELECT
874
875	!
876	!-- Depending on the grid level, set the respective bits in case of
877	!-- neighbouring walls
878	!-- Bit 0: wall to the bottom
879	!-- Bit 1: wall to the top (not realized in remaining PALM code so far)
880	!-- Bit 2: wall to the south
881	!-- Bit 3: wall to the north
882	!-- Bit 4: wall to the left
883	!-- Bit 5: wall to the right
884	!-- Bit 6: inside building
885
886	flags = 0
887
888	DO i = nxl_l-1, nxr_l+1
889	DO j = nys_l-1, nyn_l+1
890	DO k = nzb, nzt_l+1
891
892	!
893	!-- Inside/outside building (inside building does not need
894	!-- further tests for walls)
895	IF ( kinc <= nzb_local(jinc,i*inc) ) THEN
896
897	flags(k,j,i) = IBSET( flags(k,j,i), 6 )
898
899	ELSE
900	!
901	!-- Bottom wall
902	IF ( (k-1)inc <= nzb_local(jinc,i*inc) ) THEN
903	flags(k,j,i) = IBSET( flags(k,j,i), 0 )
904	ENDIF
905	!
906	!-- South wall
907	IF ( kinc <= nzb_local((j-1)inc,i*inc) ) THEN
908	flags(k,j,i) = IBSET( flags(k,j,i), 2 )
909	ENDIF
910	!
911	!-- North wall
912	IF ( kinc <= nzb_local((j+1)inc,i*inc) ) THEN
913	flags(k,j,i) = IBSET( flags(k,j,i), 3 )
914	ENDIF
915	!
916	!-- Left wall
917	IF ( kinc <= nzb_local(jinc,(i-1)*inc) ) THEN
918	flags(k,j,i) = IBSET( flags(k,j,i), 4 )
919	ENDIF
920	!
921	!-- Right wall
922	IF ( kinc <= nzb_local(jinc,(i+1)*inc) ) THEN
923	flags(k,j,i) = IBSET( flags(k,j,i), 5 )
924	ENDIF
925
926	ENDIF
927
928	ENDDO
929	ENDDO
930	ENDDO
931
932	!
933	!-- Test output of flag arrays
934	! i = nxl_l
935	! WRITE (9,*) ' '
936	! WRITE (9,) ' mg level ', l, ' *', mg_switch_to_pe0_level
937	! WRITE (9,*) ' inc=', inc, ' i =', nxl_l
938	! WRITE (9,*) ' nxl_l',nxl_l,' nxr_l=',nxr_l,' nys_l=',nys_l,' nyn_l=',nyn_l
939	! DO k = nzt_l+1, nzb, -1
940	! WRITE (9,'(194(1X,I2))') ( flags(k,j,i), j = nys_l-1, nyn_l+1 )
941	! ENDDO
942
943	inc = inc * 2
944
945	ENDDO
946
947	ENDIF
948
949	!
950	!-- In case of topography: limit near-wall mixing length l_wall further:
951	!-- Go through all points of the subdomain one by one and look for the closest
952	!-- surface
953	IF ( TRIM(topography) /= 'flat' ) THEN
954	DO i = nxl, nxr
955	DO j = nys, nyn
956
957	nzb_si = nzb_s_inner(j,i)
958	vi = vertical_influence(nzb_si)
959
960	IF ( wall_n(j,i) > 0 ) THEN
961	!
962	!-- North wall (y distance)
963	DO k = wall_n(j,i), nzb_si
964	l_wall(k,j+1,i) = MIN( l_wall(k,j+1,i), 0.5 * dy )
965	ENDDO
966	!
967	!-- Above North wall (yz distance)
968	DO k = nzb_si + 1, nzb_si + vi
969	l_wall(k,j+1,i) = MIN( l_wall(k,j+1,i), &
970	SQRT( 0.25 * dy**2 + &
971	( zu(k) - zw(nzb_si) )**2 ) )
972	ENDDO
973	!
974	!-- Northleft corner (xy distance)
975	IF ( corner_nl(j,i) > 0 ) THEN
976	DO k = corner_nl(j,i), nzb_si
977	l_wall(k,j+1,i-1) = MIN( l_wall(k,j+1,i-1), &
978	0.5 * SQRT( dx2 + dy2 ) )
979	ENDDO
980	!
981	!-- Above Northleft corner (xyz distance)
982	DO k = nzb_si + 1, nzb_si + vi
983	l_wall(k,j+1,i-1) = MIN( l_wall(k,j+1,i-1), &
984	SQRT( 0.25 * (dx2 + dy2) + &
985	( zu(k) - zw(nzb_si) )**2 ) )
986	ENDDO
987	ENDIF
988	!
989	!-- Northright corner (xy distance)
990	IF ( corner_nr(j,i) > 0 ) THEN
991	DO k = corner_nr(j,i), nzb_si
992	l_wall(k,j+1,i+1) = MIN( l_wall(k,j+1,i+1), &
993	0.5 * SQRT( dx2 + dy2 ) )
994	ENDDO
995	!
996	!-- Above northright corner (xyz distance)
997	DO k = nzb_si + 1, nzb_si + vi
998	l_wall(k,j+1,i+1) = MIN( l_wall(k,j+1,i+1), &
999	SQRT( 0.25 * (dx2 + dy2) + &
1000	( zu(k) - zw(nzb_si) )**2 ) )
1001	ENDDO
1002	ENDIF
1003	ENDIF
1004
1005	IF ( wall_s(j,i) > 0 ) THEN
1006	!
1007	!-- South wall (y distance)
1008	DO k = wall_s(j,i), nzb_si
1009	l_wall(k,j-1,i) = MIN( l_wall(k,j-1,i), 0.5 * dy )
1010	ENDDO
1011	!
1012	!-- Above south wall (yz distance)
1013	DO k = nzb_si + 1, &
1014	nzb_si + vi
1015	l_wall(k,j-1,i) = MIN( l_wall(k,j-1,i), &
1016	SQRT( 0.25 * dy**2 + &
1017	( zu(k) - zw(nzb_si) )**2 ) )
1018	ENDDO
1019	!
1020	!-- Southleft corner (xy distance)
1021	IF ( corner_sl(j,i) > 0 ) THEN
1022	DO k = corner_sl(j,i), nzb_si
1023	l_wall(k,j-1,i-1) = MIN( l_wall(k,j-1,i-1), &
1024	0.5 * SQRT( dx2 + dy2 ) )
1025	ENDDO
1026	!
1027	!-- Above southleft corner (xyz distance)
1028	DO k = nzb_si + 1, nzb_si + vi
1029	l_wall(k,j-1,i-1) = MIN( l_wall(k,j-1,i-1), &
1030	SQRT( 0.25 * (dx2 + dy2) + &
1031	( zu(k) - zw(nzb_si) )**2 ) )
1032	ENDDO
1033	ENDIF
1034	!
1035	!-- Southright corner (xy distance)
1036	IF ( corner_sr(j,i) > 0 ) THEN
1037	DO k = corner_sr(j,i), nzb_si
1038	l_wall(k,j-1,i+1) = MIN( l_wall(k,j-1,i+1), &
1039	0.5 * SQRT( dx2 + dy2 ) )
1040	ENDDO
1041	!
1042	!-- Above southright corner (xyz distance)
1043	DO k = nzb_si + 1, nzb_si + vi
1044	l_wall(k,j-1,i+1) = MIN( l_wall(k,j-1,i+1), &
1045	SQRT( 0.25 * (dx2 + dy2) + &
1046	( zu(k) - zw(nzb_si) )**2 ) )
1047	ENDDO
1048	ENDIF
1049
1050	ENDIF
1051
1052	IF ( wall_l(j,i) > 0 ) THEN
1053	!
1054	!-- Left wall (x distance)
1055	DO k = wall_l(j,i), nzb_si
1056	l_wall(k,j,i-1) = MIN( l_wall(k,j,i-1), 0.5 * dx )
1057	ENDDO
1058	!
1059	!-- Above left wall (xz distance)
1060	DO k = nzb_si + 1, nzb_si + vi
1061	l_wall(k,j,i-1) = MIN( l_wall(k,j,i-1), &
1062	SQRT( 0.25 * dx**2 + &
1063	( zu(k) - zw(nzb_si) )**2 ) )
1064	ENDDO
1065	ENDIF
1066
1067	IF ( wall_r(j,i) > 0 ) THEN
1068	!
1069	!-- Right wall (x distance)
1070	DO k = wall_r(j,i), nzb_si
1071	l_wall(k,j,i+1) = MIN( l_wall(k,j,i+1), 0.5 * dx )
1072	ENDDO
1073	!
1074	!-- Above right wall (xz distance)
1075	DO k = nzb_si + 1, nzb_si + vi
1076	l_wall(k,j,i+1) = MIN( l_wall(k,j,i+1), &
1077	SQRT( 0.25 * dx**2 + &
1078	( zu(k) - zw(nzb_si) )**2 ) )
1079	ENDDO
1080
1081	ENDIF
1082
1083	ENDDO
1084	ENDDO
1085
1086	ENDIF
1087
1088	!
1089	!-- Multiplication with wall_adjustment_factor
1090	l_wall = wall_adjustment_factor * l_wall
1091
1092	!
1093	!-- Need to set lateral boundary conditions for l_wall
1094	CALL exchange_horiz( l_wall )
1095
1096	DEALLOCATE( corner_nl, corner_nr, corner_sl, corner_sr, nzb_local, &
1097	nzb_tmp, vertical_influence, wall_l, wall_n, wall_r, wall_s )
1098
1099
1100	END SUBROUTINE init_grid

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

Context Navigation

source: palm/trunk/SOURCE/init_grid.f90 @ 420

Download in other formats: