Home

Context Navigation

data_output_2d.f90 @ 483

Last change on this file since 483 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: 48.8 KB

Line
1	SUBROUTINE data_output_2d( mode, av )
2
3	!------------------------------------------------------------------------------!
4	! Current revisions:
5	! -----------------
6	!
7	!
8	! Former revisions:
9	! -----------------
10	! $Id: data_output_2d.f90 392 2009-09-24 10:39:14Z raasch $
11	!
12	! 367 2009-08-25 08:35:52Z maronga
13	! simulated_time in NetCDF output replaced by time_since_reference_point.
14	! Output of NetCDF messages with aid of message handling routine.
15	! Bugfix: averaging along z is not allowed for 2d quantities (e.g. u* and z0)
16	! Output of messages replaced by message handling routine.
17	! Output of user defined 2D (XY) arrays at z=nzb+1 is now possible
18	! Bugfix: to_be_resorted => s_av for time-averaged scalars
19	! Calculation of shf* and qsws* added.
20	!
21	! 215 2008-11-18 09:54:31Z raasch
22	! Bugfix: no output of particle concentration and radius unless particles
23	! have been started
24	!
25	! 96 2007-06-04 08:07:41Z raasch
26	! Output of density and salinity
27	!
28	! 75 2007-03-22 09:54:05Z raasch
29	! Output of precipitation amount/rate and roughness length,
30	! 2nd+3rd argument removed from exchange horiz
31	!
32	! RCS Log replace by Id keyword, revision history cleaned up
33	!
34	! Revision 1.5 2006/08/22 13:50:29 raasch
35	! xz and yz cross sections now up to nzt+1
36	!
37	! Revision 1.2 2006/02/23 10:19:22 raasch
38	! Output of time-averaged data, output of averages along x, y, or z,
39	! output of user-defined quantities,
40	! section data are copied from local_pf to local_2d before they are output,
41	! output of particle concentration and mean radius,
42	! Former subroutine plot_2d renamed data_output_2d, pl2d.. renamed do2d..,
43	! anz renamed ngp, ebene renamed section, pl2d_.._anz renamed do2d_.._n
44	!
45	! Revision 1.1 1997/08/11 06:24:09 raasch
46	! Initial revision
47	!
48	!
49	! Description:
50	! ------------
51	! Data output of horizontal cross-sections in NetCDF format or binary format
52	! compatible to old graphic software iso2d.
53	! Attention: The position of the sectional planes is still not always computed
54	! --------- correctly. (zu is used always)!
55	!------------------------------------------------------------------------------!
56
57	USE arrays_3d
58	USE averaging
59	USE cloud_parameters
60	USE control_parameters
61	USE cpulog
62	USE grid_variables
63	USE indices
64	USE interfaces
65	USE netcdf_control
66	USE particle_attributes
67	USE pegrid
68
69	IMPLICIT NONE
70
71	CHARACTER (LEN=2) :: do2d_mode, mode
72	CHARACTER (LEN=4) :: grid
73	CHARACTER (LEN=25) :: section_chr
74	CHARACTER (LEN=50) :: rtext
75	INTEGER :: av, ngp, file_id, i, if, is, j, k, l, layer_xy, n, psi, s, &
76	sender, &
77	ind(4)
78	LOGICAL :: found, resorted, two_d
79	REAL :: mean_r, s_r3, s_r4
80	REAL, DIMENSION(:), ALLOCATABLE :: level_z
81	REAL, DIMENSION(:,:), ALLOCATABLE :: local_2d, local_2d_l
82	REAL, DIMENSION(:,:,:), ALLOCATABLE :: local_pf
83	#if defined( __parallel )
84	REAL, DIMENSION(:,:), ALLOCATABLE :: total_2d
85	#endif
86	REAL, DIMENSION(:,:,:), POINTER :: to_be_resorted
87
88	NAMELIST /LOCAL/ rtext
89
90	CALL cpu_log (log_point(3),'data_output_2d','start')
91
92	!
93	!-- Immediate return, if no output is requested (no respective sections
94	!-- found in parameter data_output)
95	IF ( mode == 'xy' .AND. .NOT. data_output_xy(av) ) RETURN
96	IF ( mode == 'xz' .AND. .NOT. data_output_xz(av) ) RETURN
97	IF ( mode == 'yz' .AND. .NOT. data_output_yz(av) ) RETURN
98
99	two_d = .FALSE. ! local variable to distinguish between output of pure 2D
100	! arrays and cross-sections of 3D arrays.
101
102	!
103	!-- Depending on the orientation of the cross-section, the respective output
104	!-- files have to be opened.
105	SELECT CASE ( mode )
106
107	CASE ( 'xy' )
108
109	s = 1
110	ALLOCATE( level_z(0:nzt+1), local_2d(nxl-1:nxr+1,nys-1:nyn+1) )
111
112	#if defined( __netcdf )
113	IF ( myid == 0 .AND. netcdf_output ) CALL check_open( 101+av*10 )
114	#endif
115
116	IF ( data_output_2d_on_each_pe ) THEN
117	CALL check_open( 21 )
118	ELSE
119	IF ( myid == 0 ) THEN
120	IF ( iso2d_output ) CALL check_open( 21 )
121	#if defined( __parallel )
122	ALLOCATE( total_2d(-1:nx+1,-1:ny+1) )
123	#endif
124	ENDIF
125	ENDIF
126
127	CASE ( 'xz' )
128
129	s = 2
130	ALLOCATE( local_2d(nxl-1:nxr+1,nzb:nzt+1) )
131
132	#if defined( __netcdf )
133	IF ( myid == 0 .AND. netcdf_output ) CALL check_open( 102+av*10 )
134	#endif
135
136	IF ( data_output_2d_on_each_pe ) THEN
137	CALL check_open( 22 )
138	ELSE
139	IF ( myid == 0 ) THEN
140	IF ( iso2d_output ) CALL check_open( 22 )
141	#if defined( __parallel )
142	ALLOCATE( total_2d(-1:nx+1,nzb:nzt+1) )
143	#endif
144	ENDIF
145	ENDIF
146
147	CASE ( 'yz' )
148
149	s = 3
150	ALLOCATE( local_2d(nys-1:nyn+1,nzb:nzt+1) )
151
152	#if defined( __netcdf )
153	IF ( myid == 0 .AND. netcdf_output ) CALL check_open( 103+av*10 )
154	#endif
155
156	IF ( data_output_2d_on_each_pe ) THEN
157	CALL check_open( 23 )
158	ELSE
159	IF ( myid == 0 ) THEN
160	IF ( iso2d_output ) CALL check_open( 23 )
161	#if defined( __parallel )
162	ALLOCATE( total_2d(-1:ny+1,nzb:nzt+1) )
163	#endif
164	ENDIF
165	ENDIF
166
167	CASE DEFAULT
168
169	message_string = 'unknown cross-section: ' // TRIM( mode )
170	CALL message( 'data_output_2d', 'PA0180', 1, 2, 0, 6, 0 )
171
172	END SELECT
173
174	!
175	!-- Allocate a temporary array for resorting (kji -> ijk).
176	ALLOCATE( local_pf(nxl-1:nxr+1,nys-1:nyn+1,nzb:nzt+1) )
177
178	!
179	!-- Loop of all variables to be written.
180	!-- Output dimensions chosen
181	if = 1
182	l = MAX( 2, LEN_TRIM( do2d(av,if) ) )
183	do2d_mode = do2d(av,if)(l-1:l)
184
185	DO WHILE ( do2d(av,if)(1:1) /= ' ' )
186
187	IF ( do2d_mode == mode ) THEN
188	!
189	!-- Store the array chosen on the temporary array.
190	resorted = .FALSE.
191	SELECT CASE ( TRIM( do2d(av,if) ) )
192
193	CASE ( 'e_xy', 'e_xz', 'e_yz' )
194	IF ( av == 0 ) THEN
195	to_be_resorted => e
196	ELSE
197	to_be_resorted => e_av
198	ENDIF
199	IF ( mode == 'xy' ) level_z = zu
200
201	CASE ( 'lwp*_xy' ) ! 2d-array
202	IF ( av == 0 ) THEN
203	DO i = nxl-1, nxr+1
204	DO j = nys-1, nyn+1
205	local_pf(i,j,nzb+1) = SUM( ql(nzb:nzt,j,i) * &
206	dzw(1:nzt+1) )
207	ENDDO
208	ENDDO
209	ELSE
210	DO i = nxl-1, nxr+1
211	DO j = nys-1, nyn+1
212	local_pf(i,j,nzb+1) = lwp_av(j,i)
213	ENDDO
214	ENDDO
215	ENDIF
216	resorted = .TRUE.
217	two_d = .TRUE.
218	level_z(nzb+1) = zu(nzb+1)
219
220	CASE ( 'p_xy', 'p_xz', 'p_yz' )
221	IF ( av == 0 ) THEN
222	to_be_resorted => p
223	ELSE
224	to_be_resorted => p_av
225	ENDIF
226	IF ( mode == 'xy' ) level_z = zu
227
228	CASE ( 'pc_xy', 'pc_xz', 'pc_yz' ) ! particle concentration
229	IF ( av == 0 ) THEN
230	IF ( simulated_time >= particle_advection_start ) THEN
231	tend = prt_count
232	CALL exchange_horiz( tend )
233	ELSE
234	tend = 0.0
235	ENDIF
236	DO i = nxl-1, nxr+1
237	DO j = nys-1, nyn+1
238	DO k = nzb, nzt+1
239	local_pf(i,j,k) = tend(k,j,i)
240	ENDDO
241	ENDDO
242	ENDDO
243	resorted = .TRUE.
244	ELSE
245	CALL exchange_horiz( pc_av )
246	to_be_resorted => pc_av
247	ENDIF
248
249	CASE ( 'pr_xy', 'pr_xz', 'pr_yz' ) ! mean particle radius
250	IF ( av == 0 ) THEN
251	IF ( simulated_time >= particle_advection_start ) THEN
252	DO i = nxl, nxr
253	DO j = nys, nyn
254	DO k = nzb, nzt+1
255	psi = prt_start_index(k,j,i)
256	s_r3 = 0.0
257	s_r4 = 0.0
258	DO n = psi, psi+prt_count(k,j,i)-1
259	s_r3 = s_r3 + particles(n)%radius**3
260	s_r4 = s_r4 + particles(n)%radius**4
261	ENDDO
262	IF ( s_r3 /= 0.0 ) THEN
263	mean_r = s_r4 / s_r3
264	ELSE
265	mean_r = 0.0
266	ENDIF
267	tend(k,j,i) = mean_r
268	ENDDO
269	ENDDO
270	ENDDO
271	CALL exchange_horiz( tend )
272	ELSE
273	tend = 0.0
274	ENDIF
275	DO i = nxl-1, nxr+1
276	DO j = nys-1, nyn+1
277	DO k = nzb, nzt+1
278	local_pf(i,j,k) = tend(k,j,i)
279	ENDDO
280	ENDDO
281	ENDDO
282	resorted = .TRUE.
283	ELSE
284	CALL exchange_horiz( pr_av )
285	to_be_resorted => pr_av
286	ENDIF
287
288	CASE ( 'pra*_xy' ) ! 2d-array / integral quantity => no av
289	CALL exchange_horiz_2d( precipitation_amount )
290	DO i = nxl-1, nxr+1
291	DO j = nys-1, nyn+1
292	local_pf(i,j,nzb+1) = precipitation_amount(j,i)
293	ENDDO
294	ENDDO
295	precipitation_amount = 0.0 ! reset for next integ. interval
296	resorted = .TRUE.
297	two_d = .TRUE.
298	level_z(nzb+1) = zu(nzb+1)
299
300	CASE ( 'prr*_xy' ) ! 2d-array
301	IF ( av == 0 ) THEN
302	CALL exchange_horiz_2d( precipitation_rate )
303	DO i = nxl-1, nxr+1
304	DO j = nys-1, nyn+1
305	local_pf(i,j,nzb+1) = precipitation_rate(j,i)
306	ENDDO
307	ENDDO
308	ELSE
309	CALL exchange_horiz_2d( precipitation_rate_av )
310	DO i = nxl-1, nxr+1
311	DO j = nys-1, nyn+1
312	local_pf(i,j,nzb+1) = precipitation_rate_av(j,i)
313	ENDDO
314	ENDDO
315	ENDIF
316	resorted = .TRUE.
317	two_d = .TRUE.
318	level_z(nzb+1) = zu(nzb+1)
319
320	CASE ( 'pt_xy', 'pt_xz', 'pt_yz' )
321	IF ( av == 0 ) THEN
322	IF ( .NOT. cloud_physics ) THEN
323	to_be_resorted => pt
324	ELSE
325	DO i = nxl-1, nxr+1
326	DO j = nys-1, nyn+1
327	DO k = nzb, nzt+1
328	local_pf(i,j,k) = pt(k,j,i) + l_d_cp * &
329	pt_d_t(k) * &
330	ql(k,j,i)
331	ENDDO
332	ENDDO
333	ENDDO
334	resorted = .TRUE.
335	ENDIF
336	ELSE
337	to_be_resorted => pt_av
338	ENDIF
339	IF ( mode == 'xy' ) level_z = zu
340
341	CASE ( 'q_xy', 'q_xz', 'q_yz' )
342	IF ( av == 0 ) THEN
343	to_be_resorted => q
344	ELSE
345	to_be_resorted => q_av
346	ENDIF
347	IF ( mode == 'xy' ) level_z = zu
348
349	CASE ( 'ql_xy', 'ql_xz', 'ql_yz' )
350	IF ( av == 0 ) THEN
351	to_be_resorted => ql
352	ELSE
353	to_be_resorted => ql_av
354	ENDIF
355	IF ( mode == 'xy' ) level_z = zu
356
357	CASE ( 'ql_c_xy', 'ql_c_xz', 'ql_c_yz' )
358	IF ( av == 0 ) THEN
359	to_be_resorted => ql_c
360	ELSE
361	to_be_resorted => ql_c_av
362	ENDIF
363	IF ( mode == 'xy' ) level_z = zu
364
365	CASE ( 'ql_v_xy', 'ql_v_xz', 'ql_v_yz' )
366	IF ( av == 0 ) THEN
367	to_be_resorted => ql_v
368	ELSE
369	to_be_resorted => ql_v_av
370	ENDIF
371	IF ( mode == 'xy' ) level_z = zu
372
373	CASE ( 'ql_vp_xy', 'ql_vp_xz', 'ql_vp_yz' )
374	IF ( av == 0 ) THEN
375	to_be_resorted => ql_vp
376	ELSE
377	to_be_resorted => ql_vp_av
378	ENDIF
379	IF ( mode == 'xy' ) level_z = zu
380
381	CASE ( 'qsws*_xy' ) ! 2d-array
382	IF ( av == 0 ) THEN
383	DO i = nxl-1, nxr+1
384	DO j = nys-1, nyn+1
385	local_pf(i,j,nzb+1) = qsws(j,i)
386	ENDDO
387	ENDDO
388	ELSE
389	DO i = nxl-1, nxr+1
390	DO j = nys-1, nyn+1
391	local_pf(i,j,nzb+1) = qsws_av(j,i)
392	ENDDO
393	ENDDO
394	ENDIF
395	resorted = .TRUE.
396	two_d = .TRUE.
397	level_z(nzb+1) = zu(nzb+1)
398
399	CASE ( 'qv_xy', 'qv_xz', 'qv_yz' )
400	IF ( av == 0 ) THEN
401	DO i = nxl-1, nxr+1
402	DO j = nys-1, nyn+1
403	DO k = nzb, nzt+1
404	local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
405	ENDDO
406	ENDDO
407	ENDDO
408	resorted = .TRUE.
409	ELSE
410	to_be_resorted => qv_av
411	ENDIF
412	IF ( mode == 'xy' ) level_z = zu
413
414	CASE ( 'rho_xy', 'rho_xz', 'rho_yz' )
415	IF ( av == 0 ) THEN
416	to_be_resorted => rho
417	ELSE
418	to_be_resorted => rho_av
419	ENDIF
420
421	CASE ( 's_xy', 's_xz', 's_yz' )
422	IF ( av == 0 ) THEN
423	to_be_resorted => q
424	ELSE
425	to_be_resorted => s_av
426	ENDIF
427
428	CASE ( 'sa_xy', 'sa_xz', 'sa_yz' )
429	IF ( av == 0 ) THEN
430	to_be_resorted => sa
431	ELSE
432	to_be_resorted => sa_av
433	ENDIF
434
435	CASE ( 'shf*_xy' ) ! 2d-array
436	IF ( av == 0 ) THEN
437	DO i = nxl-1, nxr+1
438	DO j = nys-1, nyn+1
439	local_pf(i,j,nzb+1) = shf(j,i)
440	ENDDO
441	ENDDO
442	ELSE
443	DO i = nxl-1, nxr+1
444	DO j = nys-1, nyn+1
445	local_pf(i,j,nzb+1) = shf_av(j,i)
446	ENDDO
447	ENDDO
448	ENDIF
449	resorted = .TRUE.
450	two_d = .TRUE.
451	level_z(nzb+1) = zu(nzb+1)
452
453	CASE ( 't*_xy' ) ! 2d-array
454	IF ( av == 0 ) THEN
455	DO i = nxl-1, nxr+1
456	DO j = nys-1, nyn+1
457	local_pf(i,j,nzb+1) = ts(j,i)
458	ENDDO
459	ENDDO
460	ELSE
461	DO i = nxl-1, nxr+1
462	DO j = nys-1, nyn+1
463	local_pf(i,j,nzb+1) = ts_av(j,i)
464	ENDDO
465	ENDDO
466	ENDIF
467	resorted = .TRUE.
468	two_d = .TRUE.
469	level_z(nzb+1) = zu(nzb+1)
470
471	CASE ( 'u_xy', 'u_xz', 'u_yz' )
472	IF ( av == 0 ) THEN
473	to_be_resorted => u
474	ELSE
475	to_be_resorted => u_av
476	ENDIF
477	IF ( mode == 'xy' ) level_z = zu
478	!
479	!-- Substitute the values generated by "mirror" boundary condition
480	!-- at the bottom boundary by the real surface values.
481	IF ( do2d(av,if) == 'u_xz' .OR. do2d(av,if) == 'u_yz' ) THEN
482	IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0
483	ENDIF
484
485	CASE ( 'u*_xy' ) ! 2d-array
486	IF ( av == 0 ) THEN
487	DO i = nxl-1, nxr+1
488	DO j = nys-1, nyn+1
489	local_pf(i,j,nzb+1) = us(j,i)
490	ENDDO
491	ENDDO
492	ELSE
493	DO i = nxl-1, nxr+1
494	DO j = nys-1, nyn+1
495	local_pf(i,j,nzb+1) = us_av(j,i)
496	ENDDO
497	ENDDO
498	ENDIF
499	resorted = .TRUE.
500	two_d = .TRUE.
501	level_z(nzb+1) = zu(nzb+1)
502
503	CASE ( 'v_xy', 'v_xz', 'v_yz' )
504	IF ( av == 0 ) THEN
505	to_be_resorted => v
506	ELSE
507	to_be_resorted => v_av
508	ENDIF
509	IF ( mode == 'xy' ) level_z = zu
510	!
511	!-- Substitute the values generated by "mirror" boundary condition
512	!-- at the bottom boundary by the real surface values.
513	IF ( do2d(av,if) == 'v_xz' .OR. do2d(av,if) == 'v_yz' ) THEN
514	IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0
515	ENDIF
516
517	CASE ( 'vpt_xy', 'vpt_xz', 'vpt_yz' )
518	IF ( av == 0 ) THEN
519	to_be_resorted => vpt
520	ELSE
521	to_be_resorted => vpt_av
522	ENDIF
523	IF ( mode == 'xy' ) level_z = zu
524
525	CASE ( 'w_xy', 'w_xz', 'w_yz' )
526	IF ( av == 0 ) THEN
527	to_be_resorted => w
528	ELSE
529	to_be_resorted => w_av
530	ENDIF
531	IF ( mode == 'xy' ) level_z = zw
532
533	CASE ( 'z0*_xy' ) ! 2d-array
534	IF ( av == 0 ) THEN
535	DO i = nxl-1, nxr+1
536	DO j = nys-1, nyn+1
537	local_pf(i,j,nzb+1) = z0(j,i)
538	ENDDO
539	ENDDO
540	ELSE
541	DO i = nxl-1, nxr+1
542	DO j = nys-1, nyn+1
543	local_pf(i,j,nzb+1) = z0_av(j,i)
544	ENDDO
545	ENDDO
546	ENDIF
547	resorted = .TRUE.
548	two_d = .TRUE.
549	level_z(nzb+1) = zu(nzb+1)
550
551	CASE DEFAULT
552	!
553	!-- User defined quantity
554	CALL user_data_output_2d( av, do2d(av,if), found, grid, &
555	local_pf, two_d )
556	resorted = .TRUE.
557
558	IF ( grid == 'zu' ) THEN
559	IF ( mode == 'xy' ) level_z = zu
560	ELSEIF ( grid == 'zw' ) THEN
561	IF ( mode == 'xy' ) level_z = zw
562	ELSEIF ( grid == 'zu1' ) THEN
563	IF ( mode == 'xy' ) level_z(nzb+1) = zu(nzb+1)
564	ENDIF
565
566	IF ( .NOT. found ) THEN
567	message_string = 'no output provided for: ' // &
568	TRIM( do2d(av,if) )
569	CALL message( 'data_output_2d', 'PA0181', 0, 0, 0, 6, 0 )
570	ENDIF
571
572	END SELECT
573
574	!
575	!-- Resort the array to be output, if not done above
576	IF ( .NOT. resorted ) THEN
577	DO i = nxl-1, nxr+1
578	DO j = nys-1, nyn+1
579	DO k = nzb, nzt+1
580	local_pf(i,j,k) = to_be_resorted(k,j,i)
581	ENDDO
582	ENDDO
583	ENDDO
584	ENDIF
585
586	!
587	!-- Output of the individual cross-sections, depending on the cross-
588	!-- section mode chosen.
589	is = 1
590	loop1: DO WHILE ( section(is,s) /= -9999 .OR. two_d )
591
592	SELECT CASE ( mode )
593
594	CASE ( 'xy' )
595	!
596	!-- Determine the cross section index
597	IF ( two_d ) THEN
598	layer_xy = nzb+1
599	ELSE
600	layer_xy = section(is,s)
601	ENDIF
602
603	!
604	!-- Update the NetCDF xy cross section time axis
605	IF ( myid == 0 ) THEN
606	IF ( simulated_time /= do2d_xy_last_time(av) ) THEN
607	do2d_xy_time_count(av) = do2d_xy_time_count(av) + 1
608	do2d_xy_last_time(av) = simulated_time
609	IF ( .NOT. data_output_2d_on_each_pe .AND. &
610	netcdf_output ) THEN
611	#if defined( __netcdf )
612	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
613	id_var_time_xy(av), &
614	(/ time_since_reference_point /), &
615	start = (/ do2d_xy_time_count(av) /), &
616	count = (/ 1 /) )
617	CALL handle_netcdf_error( 'data_output_2d', 53 )
618	#endif
619	ENDIF
620	ENDIF
621	ENDIF
622	!
623	!-- If required, carry out averaging along z
624	IF ( section(is,s) == -1 .AND. .NOT. two_d ) THEN
625
626	local_2d = 0.0
627	!
628	!-- Carry out the averaging (all data are on the PE)
629	DO k = nzb, nzt+1
630	DO j = nys-1, nyn+1
631	DO i = nxl-1, nxr+1
632	local_2d(i,j) = local_2d(i,j) + local_pf(i,j,k)
633	ENDDO
634	ENDDO
635	ENDDO
636
637	local_2d = local_2d / ( nzt -nzb + 2.0 )
638
639	ELSE
640	!
641	!-- Just store the respective section on the local array
642	local_2d = local_pf(:,:,layer_xy)
643
644	ENDIF
645
646	#if defined( __parallel )
647	IF ( data_output_2d_on_each_pe ) THEN
648	!
649	!-- Output of partial arrays on each PE
650	#if defined( __netcdf )
651	IF ( netcdf_output .AND. myid == 0 ) THEN
652	WRITE ( 21 ) simulated_time, do2d_xy_time_count(av), &
653	av
654	ENDIF
655	#endif
656	WRITE ( 21 ) nxl-1, nxr+1, nys-1, nyn+1
657	WRITE ( 21 ) local_2d
658
659	ELSE
660	!
661	!-- PE0 receives partial arrays from all processors and then
662	!-- outputs them. Here a barrier has to be set, because
663	!-- otherwise "-MPI- FATAL: Remote protocol queue full" may
664	!-- occur.
665	CALL MPI_BARRIER( comm2d, ierr )
666
667	ngp = ( nxr-nxl+3 ) * ( nyn-nys+3 )
668	IF ( myid == 0 ) THEN
669	!
670	!-- Local array can be relocated directly.
671	total_2d(nxl-1:nxr+1,nys-1:nyn+1) = local_2d
672	!
673	!-- Receive data from all other PEs.
674	DO n = 1, numprocs-1
675	!
676	!-- Receive index limits first, then array.
677	!-- Index limits are received in arbitrary order from
678	!-- the PEs.
679	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
680	MPI_ANY_SOURCE, 0, comm2d, status, &
681	ierr )
682	sender = status(MPI_SOURCE)
683	DEALLOCATE( local_2d )
684	ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
685	CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
686	MPI_REAL, sender, 1, comm2d, &
687	status, ierr )
688	total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
689	ENDDO
690	!
691	!-- Output of the total cross-section.
692	IF ( iso2d_output ) WRITE (21) total_2d(0:nx+1,0:ny+1)
693	!
694	!-- Relocate the local array for the next loop increment
695	DEALLOCATE( local_2d )
696	ALLOCATE( local_2d(nxl-1:nxr+1,nys-1:nyn+1) )
697
698	#if defined( __netcdf )
699	IF ( netcdf_output ) THEN
700	IF ( two_d ) THEN
701	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
702	id_var_do2d(av,if), &
703	total_2d(0:nx+1,0:ny+1), &
704	start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
705	count = (/ nx+2, ny+2, 1, 1 /) )
706	ELSE
707	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
708	id_var_do2d(av,if), &
709	total_2d(0:nx+1,0:ny+1), &
710	start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
711	count = (/ nx+2, ny+2, 1, 1 /) )
712	ENDIF
713	CALL handle_netcdf_error( 'data_output_2d', 54 )
714	ENDIF
715	#endif
716
717	ELSE
718	!
719	!-- First send the local index limits to PE0
720	ind(1) = nxl-1; ind(2) = nxr+1
721	ind(3) = nys-1; ind(4) = nyn+1
722	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, &
723	ierr )
724	!
725	!-- Send data to PE0
726	CALL MPI_SEND( local_2d(nxl-1,nys-1), ngp, MPI_REAL, &
727	0, 1, comm2d, ierr )
728	ENDIF
729	!
730	!-- A barrier has to be set, because otherwise some PEs may
731	!-- proceed too fast so that PE0 may receive wrong data on
732	!-- tag 0
733	CALL MPI_BARRIER( comm2d, ierr )
734	ENDIF
735	#else
736	IF ( iso2d_output ) THEN
737	WRITE (21) local_2d(nxl:nxr+1,nys:nyn+1)
738	ENDIF
739	#if defined( __netcdf )
740	IF ( netcdf_output ) THEN
741	IF ( two_d ) THEN
742	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
743	id_var_do2d(av,if), &
744	local_2d(nxl:nxr+1,nys:nyn+1), &
745	start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
746	count = (/ nx+2, ny+2, 1, 1 /) )
747	ELSE
748	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
749	id_var_do2d(av,if), &
750	local_2d(nxl:nxr+1,nys:nyn+1), &
751	start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
752	count = (/ nx+2, ny+2, 1, 1 /) )
753	ENDIF
754	CALL handle_netcdf_error( 'data_output_2d', 55 )
755	ENDIF
756	#endif
757	#endif
758	do2d_xy_n = do2d_xy_n + 1
759	!
760	!-- Write LOCAL parameter set for ISO2D.
761	IF ( myid == 0 .AND. iso2d_output ) THEN
762	IF ( section(is,s) /= -1 ) THEN
763	WRITE ( section_chr, '(''z = '',F7.2,'' m (GP '',I3, &
764	&'')'')' &
765	) level_z(layer_xy), layer_xy
766	ELSE
767	section_chr = 'averaged along z'
768	ENDIF
769	IF ( av == 0 ) THEN
770	rtext = TRIM( do2d(av,if) ) // ' t = ' // &
771	TRIM( simulated_time_chr ) // ' ' // &
772	TRIM( section_chr )
773	ELSE
774	rtext = TRIM( do2d(av,if) ) // ' averaged t = ' // &
775	TRIM( simulated_time_chr ) // ' ' // &
776	TRIM( section_chr )
777	ENDIF
778	WRITE (27,LOCAL)
779	ENDIF
780	!
781	!-- For 2D-arrays (e.g. u*) only one cross-section is available.
782	!-- Hence exit loop of output levels.
783	IF ( two_d ) THEN
784	two_d = .FALSE.
785	EXIT loop1
786	ENDIF
787
788	CASE ( 'xz' )
789	!
790	!-- Update the NetCDF xz cross section time axis
791	IF ( myid == 0 ) THEN
792	IF ( simulated_time /= do2d_xz_last_time(av) ) THEN
793	do2d_xz_time_count(av) = do2d_xz_time_count(av) + 1
794	do2d_xz_last_time(av) = simulated_time
795	IF ( .NOT. data_output_2d_on_each_pe .AND. &
796	netcdf_output ) THEN
797	#if defined( __netcdf )
798	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
799	id_var_time_xz(av), &
800	(/ time_since_reference_point /), &
801	start = (/ do2d_xz_time_count(av) /), &
802	count = (/ 1 /) )
803	CALL handle_netcdf_error( 'data_output_2d', 56 )
804	#endif
805	ENDIF
806	ENDIF
807	ENDIF
808	!
809	!-- If required, carry out averaging along y
810	IF ( section(is,s) == -1 ) THEN
811
812	ALLOCATE( local_2d_l(nxl-1:nxr+1,nzb:nzt+1) )
813	local_2d_l = 0.0
814	ngp = ( nxr-nxl+3 ) * ( nzt-nzb+2 )
815	!
816	!-- First local averaging on the PE
817	DO k = nzb, nzt+1
818	DO j = nys, nyn
819	DO i = nxl-1, nxr+1
820	local_2d_l(i,k) = local_2d_l(i,k) + &
821	local_pf(i,j,k)
822	ENDDO
823	ENDDO
824	ENDDO
825	#if defined( __parallel )
826	!
827	!-- Now do the averaging over all PEs along y
828	CALL MPI_ALLREDUCE( local_2d_l(nxl-1,nzb), &
829	local_2d(nxl-1,nzb), ngp, MPI_REAL, &
830	MPI_SUM, comm1dy, ierr )
831	#else
832	local_2d = local_2d_l
833	#endif
834	local_2d = local_2d / ( ny + 1.0 )
835
836	DEALLOCATE( local_2d_l )
837
838	ELSE
839	!
840	!-- Just store the respective section on the local array
841	!-- (but only if it is available on this PE!)
842	IF ( section(is,s) >= nys .AND. section(is,s) <= nyn ) &
843	THEN
844	local_2d = local_pf(:,section(is,s),nzb:nzt+1)
845	ENDIF
846
847	ENDIF
848
849	#if defined( __parallel )
850	IF ( data_output_2d_on_each_pe ) THEN
851	!
852	!-- Output of partial arrays on each PE. If the cross section
853	!-- does not reside on the PE, output special index values.
854	#if defined( __netcdf )
855	IF ( netcdf_output .AND. myid == 0 ) THEN
856	WRITE ( 22 ) simulated_time, do2d_xz_time_count(av), &
857	av
858	ENDIF
859	#endif
860	IF ( ( section(is,s)>=nys .AND. section(is,s)<=nyn ) .OR.&
861	( section(is,s) == -1 .AND. nys-1 == -1 ) ) &
862	THEN
863	WRITE (22) nxl-1, nxr+1, nzb, nzt+1
864	WRITE (22) local_2d
865	ELSE
866	WRITE (22) -1, -1, -1, -1
867	ENDIF
868
869	ELSE
870	!
871	!-- PE0 receives partial arrays from all processors of the
872	!-- respective cross section and outputs them. Here a
873	!-- barrier has to be set, because otherwise
874	!-- "-MPI- FATAL: Remote protocol queue full" may occur.
875	CALL MPI_BARRIER( comm2d, ierr )
876
877	ngp = ( nxr-nxl+3 ) * ( nzt-nzb+2 )
878	IF ( myid == 0 ) THEN
879	!
880	!-- Local array can be relocated directly.
881	IF ( ( section(is,s)>=nys .AND. section(is,s)<=nyn ) &
882	.OR. ( section(is,s) == -1 .AND. nys-1 == -1 ) ) &
883	THEN
884	total_2d(nxl-1:nxr+1,nzb:nzt+1) = local_2d
885	ENDIF
886	!
887	!-- Receive data from all other PEs.
888	DO n = 1, numprocs-1
889	!
890	!-- Receive index limits first, then array.
891	!-- Index limits are received in arbitrary order from
892	!-- the PEs.
893	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
894	MPI_ANY_SOURCE, 0, comm2d, status, &
895	ierr )
896	!
897	!-- Not all PEs have data for XZ-cross-section.
898	IF ( ind(1) /= -9999 ) THEN
899	sender = status(MPI_SOURCE)
900	DEALLOCATE( local_2d )
901	ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
902	CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
903	MPI_REAL, sender, 1, comm2d, &
904	status, ierr )
905	total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
906	ENDIF
907	ENDDO
908	!
909	!-- Output of the total cross-section.
910	IF ( iso2d_output ) THEN
911	WRITE (22) total_2d(0:nx+1,nzb:nzt+1)
912	ENDIF
913	!
914	!-- Relocate the local array for the next loop increment
915	DEALLOCATE( local_2d )
916	ALLOCATE( local_2d(nxl-1:nxr+1,nzb:nzt+1) )
917
918	#if defined( __netcdf )
919	IF ( netcdf_output ) THEN
920	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
921	id_var_do2d(av,if), &
922	total_2d(0:nx+1,nzb:nzt+1),&
923	start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
924	count = (/ nx+2, 1, nz+2, 1 /) )
925	CALL handle_netcdf_error( 'data_output_2d', 57 )
926	ENDIF
927	#endif
928
929	ELSE
930	!
931	!-- If the cross section resides on the PE, send the
932	!-- local index limits, otherwise send -9999 to PE0.
933	IF ( ( section(is,s)>=nys .AND. section(is,s)<=nyn ) &
934	.OR. ( section(is,s) == -1 .AND. nys-1 == -1 ) ) &
935	THEN
936	ind(1) = nxl-1; ind(2) = nxr+1
937	ind(3) = nzb; ind(4) = nzt+1
938	ELSE
939	ind(1) = -9999; ind(2) = -9999
940	ind(3) = -9999; ind(4) = -9999
941	ENDIF
942	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, &
943	ierr )
944	!
945	!-- If applicable, send data to PE0.
946	IF ( ind(1) /= -9999 ) THEN
947	CALL MPI_SEND( local_2d(nxl-1,nzb), ngp, MPI_REAL, &
948	0, 1, comm2d, ierr )
949	ENDIF
950	ENDIF
951	!
952	!-- A barrier has to be set, because otherwise some PEs may
953	!-- proceed too fast so that PE0 may receive wrong data on
954	!-- tag 0
955	CALL MPI_BARRIER( comm2d, ierr )
956	ENDIF
957	#else
958	IF ( iso2d_output ) THEN
959	WRITE (22) local_2d(nxl:nxr+1,nzb:nzt+1)
960	ENDIF
961	#if defined( __netcdf )
962	IF ( netcdf_output ) THEN
963	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
964	id_var_do2d(av,if), &
965	local_2d(nxl:nxr+1,nzb:nzt+1), &
966	start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
967	count = (/ nx+2, 1, nz+2, 1 /) )
968	CALL handle_netcdf_error( 'data_output_2d', 58 )
969	ENDIF
970	#endif
971	#endif
972	do2d_xz_n = do2d_xz_n + 1
973	!
974	!-- Write LOCAL-parameter set for ISO2D.
975	IF ( myid == 0 .AND. iso2d_output ) THEN
976	IF ( section(is,s) /= -1 ) THEN
977	WRITE ( section_chr, '(''y = '',F8.2,'' m (GP '',I3, &
978	&'')'')' &
979	) section(is,s)*dy, section(is,s)
980	ELSE
981	section_chr = 'averaged along y'
982	ENDIF
983	IF ( av == 0 ) THEN
984	rtext = TRIM( do2d(av,if) ) // ' t = ' // &
985	TRIM( simulated_time_chr ) // ' ' // &
986	TRIM( section_chr )
987	ELSE
988	rtext = TRIM( do2d(av,if) ) // ' averaged t = ' // &
989	TRIM( simulated_time_chr ) // ' ' // &
990	TRIM( section_chr )
991	ENDIF
992	WRITE (28,LOCAL)
993	ENDIF
994
995	CASE ( 'yz' )
996	!
997	!-- Update the NetCDF xy cross section time axis
998	IF ( myid == 0 ) THEN
999	IF ( simulated_time /= do2d_yz_last_time(av) ) THEN
1000	do2d_yz_time_count(av) = do2d_yz_time_count(av) + 1
1001	do2d_yz_last_time(av) = simulated_time
1002	IF ( .NOT. data_output_2d_on_each_pe .AND. &
1003	netcdf_output ) THEN
1004	#if defined( __netcdf )
1005	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
1006	id_var_time_yz(av), &
1007	(/ time_since_reference_point /), &
1008	start = (/ do2d_yz_time_count(av) /), &
1009	count = (/ 1 /) )
1010	CALL handle_netcdf_error( 'data_output_2d', 59 )
1011	#endif
1012	ENDIF
1013	ENDIF
1014	ENDIF
1015	!
1016	!-- If required, carry out averaging along x
1017	IF ( section(is,s) == -1 ) THEN
1018
1019	ALLOCATE( local_2d_l(nys-1:nyn+1,nzb:nzt+1) )
1020	local_2d_l = 0.0
1021	ngp = ( nyn-nys+3 ) * ( nzt-nzb+2 )
1022	!
1023	!-- First local averaging on the PE
1024	DO k = nzb, nzt+1
1025	DO j = nys-1, nyn+1
1026	DO i = nxl, nxr
1027	local_2d_l(j,k) = local_2d_l(j,k) + &
1028	local_pf(i,j,k)
1029	ENDDO
1030	ENDDO
1031	ENDDO
1032	#if defined( __parallel )
1033	!
1034	!-- Now do the averaging over all PEs along x
1035	CALL MPI_ALLREDUCE( local_2d_l(nys-1,nzb), &
1036	local_2d(nys-1,nzb), ngp, MPI_REAL, &
1037	MPI_SUM, comm1dx, ierr )
1038	#else
1039	local_2d = local_2d_l
1040	#endif
1041	local_2d = local_2d / ( nx + 1.0 )
1042
1043	DEALLOCATE( local_2d_l )
1044
1045	ELSE
1046	!
1047	!-- Just store the respective section on the local array
1048	!-- (but only if it is available on this PE!)
1049	IF ( section(is,s) >= nxl .AND. section(is,s) <= nxr ) &
1050	THEN
1051	local_2d = local_pf(section(is,s),:,nzb:nzt+1)
1052	ENDIF
1053
1054	ENDIF
1055
1056	#if defined( __parallel )
1057	IF ( data_output_2d_on_each_pe ) THEN
1058	!
1059	!-- Output of partial arrays on each PE. If the cross section
1060	!-- does not reside on the PE, output special index values.
1061	#if defined( __netcdf )
1062	IF ( netcdf_output .AND. myid == 0 ) THEN
1063	WRITE ( 23 ) simulated_time, do2d_yz_time_count(av), &
1064	av
1065	ENDIF
1066	#endif
1067	IF ( ( section(is,s)>=nxl .AND. section(is,s)<=nxr ) .OR.&
1068	( section(is,s) == -1 .AND. nxl-1 == -1 ) ) &
1069	THEN
1070	WRITE (23) nys-1, nyn+1, nzb, nzt+1
1071	WRITE (23) local_2d
1072	ELSE
1073	WRITE (23) -1, -1, -1, -1
1074	ENDIF
1075
1076	ELSE
1077	!
1078	!-- PE0 receives partial arrays from all processors of the
1079	!-- respective cross section and outputs them. Here a
1080	!-- barrier has to be set, because otherwise
1081	!-- "-MPI- FATAL: Remote protocol queue full" may occur.
1082	CALL MPI_BARRIER( comm2d, ierr )
1083
1084	ngp = ( nyn-nys+3 ) * ( nzt-nzb+2 )
1085	IF ( myid == 0 ) THEN
1086	!
1087	!-- Local array can be relocated directly.
1088	IF ( ( section(is,s)>=nxl .AND. section(is,s)<=nxr ) &
1089	.OR. ( section(is,s) == -1 .AND. nxl-1 == -1 ) ) &
1090	THEN
1091	total_2d(nys-1:nyn+1,nzb:nzt+1) = local_2d
1092	ENDIF
1093	!
1094	!-- Receive data from all other PEs.
1095	DO n = 1, numprocs-1
1096	!
1097	!-- Receive index limits first, then array.
1098	!-- Index limits are received in arbitrary order from
1099	!-- the PEs.
1100	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
1101	MPI_ANY_SOURCE, 0, comm2d, status, &
1102	ierr )
1103	!
1104	!-- Not all PEs have data for YZ-cross-section.
1105	IF ( ind(1) /= -9999 ) THEN
1106	sender = status(MPI_SOURCE)
1107	DEALLOCATE( local_2d )
1108	ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
1109	CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
1110	MPI_REAL, sender, 1, comm2d, &
1111	status, ierr )
1112	total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
1113	ENDIF
1114	ENDDO
1115	!
1116	!-- Output of the total cross-section.
1117	IF ( iso2d_output ) THEN
1118	WRITE (23) total_2d(0:ny+1,nzb:nzt+1)
1119	ENDIF
1120	!
1121	!-- Relocate the local array for the next loop increment
1122	DEALLOCATE( local_2d )
1123	ALLOCATE( local_2d(nys-1:nyn+1,nzb:nzt+1) )
1124
1125	#if defined( __netcdf )
1126	IF ( netcdf_output ) THEN
1127	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
1128	id_var_do2d(av,if), &
1129	total_2d(0:ny+1,nzb:nzt+1),&
1130	start = (/ is, 1, 1, do2d_yz_time_count(av) /), &
1131	count = (/ 1, ny+2, nz+2, 1 /) )
1132	CALL handle_netcdf_error( 'data_output_2d', 60 )
1133	ENDIF
1134	#endif
1135
1136	ELSE
1137	!
1138	!-- If the cross section resides on the PE, send the
1139	!-- local index limits, otherwise send -9999 to PE0.
1140	IF ( ( section(is,s)>=nxl .AND. section(is,s)<=nxr ) &
1141	.OR. ( section(is,s) == -1 .AND. nxl-1 == -1 ) ) &
1142	THEN
1143	ind(1) = nys-1; ind(2) = nyn+1
1144	ind(3) = nzb; ind(4) = nzt+1
1145	ELSE
1146	ind(1) = -9999; ind(2) = -9999
1147	ind(3) = -9999; ind(4) = -9999
1148	ENDIF
1149	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, &
1150	ierr )
1151	!
1152	!-- If applicable, send data to PE0.
1153	IF ( ind(1) /= -9999 ) THEN
1154	CALL MPI_SEND( local_2d(nys-1,nzb), ngp, MPI_REAL, &
1155	0, 1, comm2d, ierr )
1156	ENDIF
1157	ENDIF
1158	!
1159	!-- A barrier has to be set, because otherwise some PEs may
1160	!-- proceed too fast so that PE0 may receive wrong data on
1161	!-- tag 0
1162	CALL MPI_BARRIER( comm2d, ierr )
1163	ENDIF
1164	#else
1165	IF ( iso2d_output ) THEN
1166	WRITE (23) local_2d(nys:nyn+1,nzb:nzt+1)
1167	ENDIF
1168	#if defined( __netcdf )
1169	IF ( netcdf_output ) THEN
1170	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
1171	id_var_do2d(av,if), &
1172	local_2d(nys:nyn+1,nzb:nzt+1), &
1173	start = (/ is, 1, 1, do2d_xz_time_count(av) /), &
1174	count = (/ 1, ny+2, nz+2, 1 /) )
1175	CALL handle_netcdf_error( 'data_output_2d', 61 )
1176	ENDIF
1177	#endif
1178	#endif
1179	do2d_yz_n = do2d_yz_n + 1
1180	!
1181	!-- Write LOCAL-parameter set for ISO2D.
1182	IF ( myid == 0 .AND. iso2d_output ) THEN
1183	IF ( section(is,s) /= -1 ) THEN
1184	WRITE ( section_chr, '(''x = '',F8.2,'' m (GP '',I3, &
1185	&'')'')' &
1186	) section(is,s)*dx, section(is,s)
1187	ELSE
1188	section_chr = 'averaged along x'
1189	ENDIF
1190	IF ( av == 0 ) THEN
1191	rtext = TRIM( do2d(av,if) ) // ' t = ' // &
1192	TRIM( simulated_time_chr ) // ' ' // &
1193	TRIM( section_chr )
1194	ELSE
1195	rtext = TRIM( do2d(av,if) ) // ' averaged t = ' // &
1196	TRIM( simulated_time_chr ) // ' ' // &
1197	TRIM( section_chr )
1198	ENDIF
1199	WRITE (29,LOCAL)
1200	ENDIF
1201
1202	END SELECT
1203
1204	is = is + 1
1205	ENDDO loop1
1206
1207	ENDIF
1208
1209	if = if + 1
1210	l = MAX( 2, LEN_TRIM( do2d(av,if) ) )
1211	do2d_mode = do2d(av,if)(l-1:l)
1212
1213	ENDDO
1214
1215	!
1216	!-- Deallocate temporary arrays.
1217	IF ( ALLOCATED( level_z ) ) DEALLOCATE( level_z )
1218	DEALLOCATE( local_pf, local_2d )
1219	#if defined( __parallel )
1220	IF ( .NOT. data_output_2d_on_each_pe .AND. myid == 0 ) THEN
1221	DEALLOCATE( total_2d )
1222	ENDIF
1223	#endif
1224
1225	!
1226	!-- Close plot output file.
1227	file_id = 20 + s
1228
1229	IF ( data_output_2d_on_each_pe ) THEN
1230	CALL close_file( file_id )
1231	ELSE
1232	IF ( myid == 0 ) CALL close_file( file_id )
1233	ENDIF
1234
1235
1236	CALL cpu_log (log_point(3),'data_output_2d','stop','nobarrier')
1237
1238	END SUBROUTINE data_output_2d

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

Context Navigation

source: palm/trunk/SOURCE/data_output_2d.f90 @ 483

Download in other formats: