Home

Context Navigation

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

Last change on this file since 1682 was 1682, checked in by knoop, 9 years ago
Code annotations made doxygen readable
Property svn:keywords set to `Id`
File size: 84.6 KB

Line
1	!> @file data_output_2d.f90
2	!--------------------------------------------------------------------------------!
3	! This file is part of PALM.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the terms
6	! of the GNU General Public License as published by the Free Software Foundation,
7	! either version 3 of the License, or (at your option) any later version.
8	!
9	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
10	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
11	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
12	!
13	! You should have received a copy of the GNU General Public License along with
14	! PALM. If not, see <http://www.gnu.org/licenses/>.
15	!
16	! Copyright 1997-2014 Leibniz Universitaet Hannover
17	!--------------------------------------------------------------------------------!
18	!
19	! Current revisions:
20	! -----------------
21	! Code annotations made doxygen readable
22	!
23	! Former revisions:
24	! -----------------
25	! $Id: data_output_2d.f90 1682 2015-10-07 23:56:08Z knoop $
26	!
27	! 1585 2015-04-30 07:05:52Z maronga
28	! Added support for RRTMG
29	!
30	! 1555 2015-03-04 17:44:27Z maronga
31	! Added output of r_a and r_s
32	!
33	! 1551 2015-03-03 14:18:16Z maronga
34	! Added suppport for land surface model and radiation model output. In the course
35	! of this action, the limits for vertical loops have been changed (from nzb and
36	! nzt+1 to nzb_do and nzt_do, respectively in order to allow soil model output).
37	! Moreover, a new vertical grid zs was introduced.
38	!
39	! 1359 2014-04-11 17:15:14Z hoffmann
40	! New particle structure integrated.
41	!
42	! 1353 2014-04-08 15:21:23Z heinze
43	! REAL constants provided with KIND-attribute
44	!
45	! 1327 2014-03-21 11:00:16Z raasch
46	! parts concerning iso2d output removed,
47	! -netcdf output queries
48	!
49	! 1320 2014-03-20 08:40:49Z raasch
50	! ONLY-attribute added to USE-statements,
51	! kind-parameters added to all INTEGER and REAL declaration statements,
52	! kinds are defined in new module kinds,
53	! revision history before 2012 removed,
54	! comment fields (!:) to be used for variable explanations added to
55	! all variable declaration statements
56	!
57	! 1318 2014-03-17 13:35:16Z raasch
58	! barrier argument removed from cpu_log.
59	! module interfaces removed
60	!
61	! 1311 2014-03-14 12:13:39Z heinze
62	! bugfix: close #if defined( __netcdf )
63	!
64	! 1308 2014-03-13 14:58:42Z fricke
65	! +local_2d_sections, local_2d_sections_l, ns
66	! Check, if the limit of the time dimension is exceeded for parallel output
67	! To increase the performance for parallel output, the following is done:
68	! - Update of time axis is only done by PE0
69	! - Cross sections are first stored on a local array and are written
70	! collectively to the output file by all PEs.
71	!
72	! 1115 2013-03-26 18:16:16Z hoffmann
73	! ql is calculated by calc_liquid_water_content
74	!
75	! 1076 2012-12-05 08:30:18Z hoffmann
76	! Bugfix in output of ql
77	!
78	! 1065 2012-11-22 17:42:36Z hoffmann
79	! Bugfix: Output of cross sections of ql
80	!
81	! 1053 2012-11-13 17:11:03Z hoffmann
82	! +qr, nr, qc and cross sections
83	!
84	! 1036 2012-10-22 13:43:42Z raasch
85	! code put under GPL (PALM 3.9)
86	!
87	! 1031 2012-10-19 14:35:30Z raasch
88	! netCDF4 without parallel file support implemented
89	!
90	! 1007 2012-09-19 14:30:36Z franke
91	! Bugfix: missing calculation of ql_vp added
92	!
93	! 978 2012-08-09 08:28:32Z fricke
94	! +z0h
95	!
96	! Revision 1.1 1997/08/11 06:24:09 raasch
97	! Initial revision
98	!
99	!
100	! Description:
101	! ------------
102	!> Data output of horizontal cross-sections in netCDF format or binary format
103	!> compatible to old graphic software iso2d.
104	!> Attention: The position of the sectional planes is still not always computed
105	!> --------- correctly. (zu is used always)!
106	!------------------------------------------------------------------------------!
107	SUBROUTINE data_output_2d( mode, av )
108
109
110	USE arrays_3d, &
111	ONLY: dzw, e, nr, p, pt, q, qc, ql, ql_c, ql_v, ql_vp, qr, qsws, &
112	rho, sa, shf, tend, ts, u, us, v, vpt, w, z0, z0h, zu, zw
113
114	USE averaging
115
116	USE cloud_parameters, &
117	ONLY: hyrho, l_d_cp, precipitation_amount, precipitation_rate, prr, &
118	pt_d_t
119
120	USE control_parameters, &
121	ONLY: cloud_physics, data_output_2d_on_each_pe, data_output_xy, &
122	data_output_xz, data_output_yz, do2d, &
123	do2d_xy_last_time, do2d_xy_n, do2d_xy_time_count, &
124	do2d_xz_last_time, do2d_xz_n, do2d_xz_time_count, &
125	do2d_yz_last_time, do2d_yz_n, do2d_yz_time_count, &
126	ibc_uv_b, icloud_scheme, io_blocks, io_group, &
127	message_string, netcdf_data_format, &
128	ntdim_2d_xy, ntdim_2d_xz, ntdim_2d_yz, psolver, section, &
129	simulated_time, simulated_time_chr, time_since_reference_point
130
131	USE cpulog, &
132	ONLY: cpu_log, log_point
133
134	USE grid_variables, &
135	ONLY: dx, dy
136
137	USE indices, &
138	ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, &
139	nz, nzb, nzt
140
141	USE kinds
142
143	USE land_surface_model_mod, &
144	ONLY: c_liq, c_liq_av, c_soil_av, c_veg, c_veg_av, ghf_eb, &
145	ghf_eb_av, lai, lai_av, m_liq_eb, m_liq_eb_av, m_soil, &
146	m_soil_av, nzb_soil, nzt_soil, qsws_eb, qsws_eb_av, &
147	qsws_liq_eb, qsws_liq_eb_av, qsws_soil_eb, qsws_soil_eb_av, &
148	qsws_veg_eb, qsws_veg_eb_av, r_a, r_a_av, r_s, r_s_av, shf_eb, &
149	shf_eb_av, t_soil, t_soil_av, zs
150
151	USE netcdf_control
152
153	USE particle_attributes, &
154	ONLY: grid_particles, number_of_particles, particle_advection_start, &
155	particles, prt_count
156
157	USE pegrid
158
159	USE radiation_model_mod, &
160	ONLY: rad_net, rad_net_av, rad_sw_in, rad_sw_in_av, rad_sw_out, &
161	rad_sw_out_av, rad_lw_in, rad_lw_in_av, rad_lw_out, &
162	rad_lw_out_av
163
164	IMPLICIT NONE
165
166	CHARACTER (LEN=2) :: do2d_mode !<
167	CHARACTER (LEN=2) :: mode !<
168	CHARACTER (LEN=4) :: grid !<
169	CHARACTER (LEN=25) :: section_chr !<
170	CHARACTER (LEN=50) :: rtext !<
171
172	INTEGER(iwp) :: av !<
173	INTEGER(iwp) :: ngp !<
174	INTEGER(iwp) :: file_id !<
175	INTEGER(iwp) :: i !<
176	INTEGER(iwp) :: if !<
177	INTEGER(iwp) :: is !<
178	INTEGER(iwp) :: iis !<
179	INTEGER(iwp) :: j !<
180	INTEGER(iwp) :: k !<
181	INTEGER(iwp) :: l !<
182	INTEGER(iwp) :: layer_xy !<
183	INTEGER(iwp) :: n !<
184	INTEGER(iwp) :: ns !<
185	INTEGER(iwp) :: nzb_do !< lower limit of the data field (usually nzb)
186	INTEGER(iwp) :: nzt_do !< upper limit of the data field (usually nzt+1)
187	INTEGER(iwp) :: psi !<
188	INTEGER(iwp) :: s !<
189	INTEGER(iwp) :: sender !<
190	INTEGER(iwp) :: ind(4) !<
191
192	LOGICAL :: found !<
193	LOGICAL :: resorted !<
194	LOGICAL :: two_d !<
195
196	REAL(wp) :: mean_r !<
197	REAL(wp) :: s_r2 !<
198	REAL(wp) :: s_r3 !<
199
200	REAL(wp), DIMENSION(:), ALLOCATABLE :: level_z !<
201	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: local_2d !<
202	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: local_2d_l !<
203	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !<
204	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_2d_sections !<
205	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_2d_sections_l !<
206
207	#if defined( __parallel )
208	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: total_2d !<
209	#endif
210	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !<
211
212	NAMELIST /LOCAL/ rtext
213
214	!
215	!-- Immediate return, if no output is requested (no respective sections
216	!-- found in parameter data_output)
217	IF ( mode == 'xy' .AND. .NOT. data_output_xy(av) ) RETURN
218	IF ( mode == 'xz' .AND. .NOT. data_output_xz(av) ) RETURN
219	IF ( mode == 'yz' .AND. .NOT. data_output_yz(av) ) RETURN
220	!
221	!-- For parallel netcdf output the time axis must be limited. Return, if this
222	!-- limit is exceeded. This could be the case, if the simulated time exceeds
223	!-- the given end time by the length of the given output interval.
224	IF ( netcdf_data_format > 4 ) THEN
225	IF ( mode == 'xy' .AND. do2d_xy_time_count(av) + 1 > &
226	ntdim_2d_xy(av) ) THEN
227	WRITE ( message_string, * ) 'Output of xy cross-sections is not ', &
228	'given at t=', simulated_time, '&because the', &
229	' maximum number of output time levels is exceeded.'
230	CALL message( 'data_output_2d', 'PA0384', 0, 1, 0, 6, 0 )
231	RETURN
232	ENDIF
233	IF ( mode == 'xz' .AND. do2d_xz_time_count(av) + 1 > &
234	ntdim_2d_xz(av) ) THEN
235	WRITE ( message_string, * ) 'Output of xz cross-sections is not ', &
236	'given at t=', simulated_time, '&because the', &
237	' maximum number of output time levels is exceeded.'
238	CALL message( 'data_output_2d', 'PA0385', 0, 1, 0, 6, 0 )
239	RETURN
240	ENDIF
241	IF ( mode == 'yz' .AND. do2d_yz_time_count(av) + 1 > &
242	ntdim_2d_yz(av) ) THEN
243	WRITE ( message_string, * ) 'Output of yz cross-sections is not ', &
244	'given at t=', simulated_time, '&because the', &
245	' maximum number of output time levels is exceeded.'
246	CALL message( 'data_output_2d', 'PA0386', 0, 1, 0, 6, 0 )
247	RETURN
248	ENDIF
249	ENDIF
250
251	CALL cpu_log (log_point(3),'data_output_2d','start')
252
253	two_d = .FALSE. ! local variable to distinguish between output of pure 2D
254	! arrays and cross-sections of 3D arrays.
255
256	!
257	!-- Depending on the orientation of the cross-section, the respective output
258	!-- files have to be opened.
259	SELECT CASE ( mode )
260
261	CASE ( 'xy' )
262	s = 1
263	ALLOCATE( level_z(nzb:nzt+1), local_2d(nxlg:nxrg,nysg:nyng) )
264
265	IF ( netcdf_data_format > 4 ) THEN
266	ns = 1
267	DO WHILE ( section(ns,s) /= -9999 .AND. ns <= 100 )
268	ns = ns + 1
269	ENDDO
270	ns = ns - 1
271	ALLOCATE( local_2d_sections(nxlg:nxrg,nysg:nyng,1:ns) )
272	local_2d_sections = 0.0_wp
273	ENDIF
274
275	!
276	!-- Parallel netCDF4/HDF5 output is done on all PEs, all other on PE0 only
277	IF ( myid == 0 .OR. netcdf_data_format > 4 ) THEN
278	CALL check_open( 101+av*10 )
279	ENDIF
280
281	IF ( data_output_2d_on_each_pe ) THEN
282	CALL check_open( 21 )
283	ELSE
284	IF ( myid == 0 ) THEN
285	#if defined( __parallel )
286	ALLOCATE( total_2d(-nbgp:nx+nbgp,-nbgp:ny+nbgp) )
287	#endif
288	ENDIF
289	ENDIF
290
291	CASE ( 'xz' )
292	s = 2
293	ALLOCATE( local_2d(nxlg:nxrg,nzb:nzt+1) )
294
295	IF ( netcdf_data_format > 4 ) THEN
296	ns = 1
297	DO WHILE ( section(ns,s) /= -9999 .AND. ns <= 100 )
298	ns = ns + 1
299	ENDDO
300	ns = ns - 1
301	ALLOCATE( local_2d_sections(nxlg:nxrg,1:ns,nzb:nzt+1) )
302	ALLOCATE( local_2d_sections_l(nxlg:nxrg,1:ns,nzb:nzt+1) )
303	local_2d_sections = 0.0_wp; local_2d_sections_l = 0.0_wp
304	ENDIF
305
306	!
307	!-- Parallel netCDF4/HDF5 output is done on all PEs, all other on PE0 only
308	IF ( myid == 0 .OR. netcdf_data_format > 4 ) THEN
309	CALL check_open( 102+av*10 )
310	ENDIF
311
312	IF ( data_output_2d_on_each_pe ) THEN
313	CALL check_open( 22 )
314	ELSE
315	IF ( myid == 0 ) THEN
316	#if defined( __parallel )
317	ALLOCATE( total_2d(-nbgp:nx+nbgp,nzb:nzt+1) )
318	#endif
319	ENDIF
320	ENDIF
321
322	CASE ( 'yz' )
323	s = 3
324	ALLOCATE( local_2d(nysg:nyng,nzb:nzt+1) )
325
326	IF ( netcdf_data_format > 4 ) THEN
327	ns = 1
328	DO WHILE ( section(ns,s) /= -9999 .AND. ns <= 100 )
329	ns = ns + 1
330	ENDDO
331	ns = ns - 1
332	ALLOCATE( local_2d_sections(1:ns,nysg:nyng,nzb:nzt+1) )
333	ALLOCATE( local_2d_sections_l(1:ns,nysg:nyng,nzb:nzt+1) )
334	local_2d_sections = 0.0_wp; local_2d_sections_l = 0.0_wp
335	ENDIF
336
337	!
338	!-- Parallel netCDF4/HDF5 output is done on all PEs, all other on PE0 only
339	IF ( myid == 0 .OR. netcdf_data_format > 4 ) THEN
340	CALL check_open( 103+av*10 )
341	ENDIF
342
343	IF ( data_output_2d_on_each_pe ) THEN
344	CALL check_open( 23 )
345	ELSE
346	IF ( myid == 0 ) THEN
347	#if defined( __parallel )
348	ALLOCATE( total_2d(-nbgp:ny+nbgp,nzb:nzt+1) )
349	#endif
350	ENDIF
351	ENDIF
352
353	CASE DEFAULT
354	message_string = 'unknown cross-section: ' // TRIM( mode )
355	CALL message( 'data_output_2d', 'PA0180', 1, 2, 0, 6, 0 )
356
357	END SELECT
358
359	!
360	!-- Allocate a temporary array for resorting (kji -> ijk).
361	ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb:nzt+1) )
362
363	!
364	!-- Loop of all variables to be written.
365	!-- Output dimensions chosen
366	if = 1
367	l = MAX( 2, LEN_TRIM( do2d(av,if) ) )
368	do2d_mode = do2d(av,if)(l-1:l)
369
370	DO WHILE ( do2d(av,if)(1:1) /= ' ' )
371
372	IF ( do2d_mode == mode ) THEN
373
374	nzb_do = nzb
375	nzt_do = nzt+1
376	!
377	!-- Store the array chosen on the temporary array.
378	resorted = .FALSE.
379	SELECT CASE ( TRIM( do2d(av,if) ) )
380
381	CASE ( 'e_xy', 'e_xz', 'e_yz' )
382	IF ( av == 0 ) THEN
383	to_be_resorted => e
384	ELSE
385	to_be_resorted => e_av
386	ENDIF
387	IF ( mode == 'xy' ) level_z = zu
388
389	CASE ( 'c_liq*_xy' ) ! 2d-array
390	IF ( av == 0 ) THEN
391	DO i = nxlg, nxrg
392	DO j = nysg, nyng
393	local_pf(i,j,nzb+1) = c_liq(j,i) * c_veg(j,i)
394	ENDDO
395	ENDDO
396	ELSE
397	DO i = nxlg, nxrg
398	DO j = nysg, nyng
399	local_pf(i,j,nzb+1) = c_liq_av(j,i)
400	ENDDO
401	ENDDO
402	ENDIF
403	resorted = .TRUE.
404	two_d = .TRUE.
405	level_z(nzb+1) = zu(nzb+1)
406
407	CASE ( 'c_soil*_xy' ) ! 2d-array
408	IF ( av == 0 ) THEN
409	DO i = nxlg, nxrg
410	DO j = nysg, nyng
411	local_pf(i,j,nzb+1) = 1.0_wp - c_veg(j,i)
412	ENDDO
413	ENDDO
414	ELSE
415	DO i = nxlg, nxrg
416	DO j = nysg, nyng
417	local_pf(i,j,nzb+1) = c_soil_av(j,i)
418	ENDDO
419	ENDDO
420	ENDIF
421	resorted = .TRUE.
422	two_d = .TRUE.
423	level_z(nzb+1) = zu(nzb+1)
424
425	CASE ( 'c_veg*_xy' ) ! 2d-array
426	IF ( av == 0 ) THEN
427	DO i = nxlg, nxrg
428	DO j = nysg, nyng
429	local_pf(i,j,nzb+1) = c_veg(j,i)
430	ENDDO
431	ENDDO
432	ELSE
433	DO i = nxlg, nxrg
434	DO j = nysg, nyng
435	local_pf(i,j,nzb+1) = c_veg_av(j,i)
436	ENDDO
437	ENDDO
438	ENDIF
439	resorted = .TRUE.
440	two_d = .TRUE.
441	level_z(nzb+1) = zu(nzb+1)
442
443	CASE ( 'ghf_eb*_xy' ) ! 2d-array
444	IF ( av == 0 ) THEN
445	DO i = nxlg, nxrg
446	DO j = nysg, nyng
447	local_pf(i,j,nzb+1) = ghf_eb(j,i)
448	ENDDO
449	ENDDO
450	ELSE
451	DO i = nxlg, nxrg
452	DO j = nysg, nyng
453	local_pf(i,j,nzb+1) = ghf_eb_av(j,i)
454	ENDDO
455	ENDDO
456	ENDIF
457	resorted = .TRUE.
458	two_d = .TRUE.
459	level_z(nzb+1) = zu(nzb+1)
460
461	CASE ( 'lai*_xy' ) ! 2d-array
462	IF ( av == 0 ) THEN
463	DO i = nxlg, nxrg
464	DO j = nysg, nyng
465	local_pf(i,j,nzb+1) = lai(j,i)
466	ENDDO
467	ENDDO
468	ELSE
469	DO i = nxlg, nxrg
470	DO j = nysg, nyng
471	local_pf(i,j,nzb+1) = lai_av(j,i)
472	ENDDO
473	ENDDO
474	ENDIF
475	resorted = .TRUE.
476	two_d = .TRUE.
477	level_z(nzb+1) = zu(nzb+1)
478
479	CASE ( 'lpt_xy', 'lpt_xz', 'lpt_yz' )
480	IF ( av == 0 ) THEN
481	to_be_resorted => pt
482	ELSE
483	to_be_resorted => lpt_av
484	ENDIF
485	IF ( mode == 'xy' ) level_z = zu
486
487	CASE ( 'lwp*_xy' ) ! 2d-array
488	IF ( av == 0 ) THEN
489	DO i = nxlg, nxrg
490	DO j = nysg, nyng
491	local_pf(i,j,nzb+1) = SUM( ql(nzb:nzt,j,i) * &
492	dzw(1:nzt+1) )
493	ENDDO
494	ENDDO
495	ELSE
496	DO i = nxlg, nxrg
497	DO j = nysg, nyng
498	local_pf(i,j,nzb+1) = lwp_av(j,i)
499	ENDDO
500	ENDDO
501	ENDIF
502	resorted = .TRUE.
503	two_d = .TRUE.
504	level_z(nzb+1) = zu(nzb+1)
505
506	CASE ( 'm_liq_eb*_xy' ) ! 2d-array
507	IF ( av == 0 ) THEN
508	DO i = nxlg, nxrg
509	DO j = nysg, nyng
510	local_pf(i,j,nzb+1) = m_liq_eb(j,i)
511	ENDDO
512	ENDDO
513	ELSE
514	DO i = nxlg, nxrg
515	DO j = nysg, nyng
516	local_pf(i,j,nzb+1) = m_liq_eb_av(j,i)
517	ENDDO
518	ENDDO
519	ENDIF
520	resorted = .TRUE.
521	two_d = .TRUE.
522	level_z(nzb+1) = zu(nzb+1)
523
524	CASE ( 'm_soil_xy', 'm_soil_xz', 'm_soil_yz' )
525	nzb_do = nzb_soil
526	nzt_do = nzt_soil
527	IF ( av == 0 ) THEN
528	to_be_resorted => m_soil
529	ELSE
530	to_be_resorted => m_soil_av
531	ENDIF
532	IF ( mode == 'xy' ) level_z = zs
533
534	CASE ( 'nr_xy', 'nr_xz', 'nr_yz' )
535	IF ( av == 0 ) THEN
536	to_be_resorted => nr
537	ELSE
538	to_be_resorted => nr_av
539	ENDIF
540	IF ( mode == 'xy' ) level_z = zu
541
542	CASE ( 'p_xy', 'p_xz', 'p_yz' )
543	IF ( av == 0 ) THEN
544	IF ( psolver /= 'sor' ) CALL exchange_horiz( p, nbgp )
545	to_be_resorted => p
546	ELSE
547	IF ( psolver /= 'sor' ) CALL exchange_horiz( p_av, nbgp )
548	to_be_resorted => p_av
549	ENDIF
550	IF ( mode == 'xy' ) level_z = zu
551
552	CASE ( 'pc_xy', 'pc_xz', 'pc_yz' ) ! particle concentration
553	IF ( av == 0 ) THEN
554	IF ( simulated_time >= particle_advection_start ) THEN
555	tend = prt_count
556	CALL exchange_horiz( tend, nbgp )
557	ELSE
558	tend = 0.0_wp
559	ENDIF
560	DO i = nxlg, nxrg
561	DO j = nysg, nyng
562	DO k = nzb, nzt+1
563	local_pf(i,j,k) = tend(k,j,i)
564	ENDDO
565	ENDDO
566	ENDDO
567	resorted = .TRUE.
568	ELSE
569	CALL exchange_horiz( pc_av, nbgp )
570	to_be_resorted => pc_av
571	ENDIF
572
573	CASE ( 'pr_xy', 'pr_xz', 'pr_yz' ) ! mean particle radius (effective radius)
574	IF ( av == 0 ) THEN
575	IF ( simulated_time >= particle_advection_start ) THEN
576	DO i = nxl, nxr
577	DO j = nys, nyn
578	DO k = nzb, nzt+1
579	number_of_particles = prt_count(k,j,i)
580	IF (number_of_particles <= 0) CYCLE
581	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
582	s_r2 = 0.0_wp
583	s_r3 = 0.0_wp
584	DO n = 1, number_of_particles
585	IF ( particles(n)%particle_mask ) THEN
586	s_r2 = s_r2 + particles(n)%radius*2 &
587	particles(n)%weight_factor
588	s_r3 = s_r3 + particles(n)%radius*3 &
589	particles(n)%weight_factor
590	ENDIF
591	ENDDO
592	IF ( s_r2 > 0.0_wp ) THEN
593	mean_r = s_r3 / s_r2
594	ELSE
595	mean_r = 0.0_wp
596	ENDIF
597	tend(k,j,i) = mean_r
598	ENDDO
599	ENDDO
600	ENDDO
601	CALL exchange_horiz( tend, nbgp )
602	ELSE
603	tend = 0.0_wp
604	ENDIF
605	DO i = nxlg, nxrg
606	DO j = nysg, nyng
607	DO k = nzb, nzt+1
608	local_pf(i,j,k) = tend(k,j,i)
609	ENDDO
610	ENDDO
611	ENDDO
612	resorted = .TRUE.
613	ELSE
614	CALL exchange_horiz( pr_av, nbgp )
615	to_be_resorted => pr_av
616	ENDIF
617
618	CASE ( 'pra*_xy' ) ! 2d-array / integral quantity => no av
619	CALL exchange_horiz_2d( precipitation_amount )
620	DO i = nxlg, nxrg
621	DO j = nysg, nyng
622	local_pf(i,j,nzb+1) = precipitation_amount(j,i)
623	ENDDO
624	ENDDO
625	precipitation_amount = 0.0_wp ! reset for next integ. interval
626	resorted = .TRUE.
627	two_d = .TRUE.
628	level_z(nzb+1) = zu(nzb+1)
629
630	CASE ( 'prr*_xy' ) ! 2d-array
631	IF ( icloud_scheme == 1 ) THEN
632	IF ( av == 0 ) THEN
633	CALL exchange_horiz_2d( precipitation_rate )
634	DO i = nxlg, nxrg
635	DO j = nysg, nyng
636	local_pf(i,j,nzb+1) = precipitation_rate(j,i)
637	ENDDO
638	ENDDO
639	ELSE
640	CALL exchange_horiz_2d( precipitation_rate_av )
641	DO i = nxlg, nxrg
642	DO j = nysg, nyng
643	local_pf(i,j,nzb+1) = precipitation_rate_av(j,i)
644	ENDDO
645	ENDDO
646	ENDIF
647	ELSE
648	IF ( av == 0 ) THEN
649	CALL exchange_horiz_2d( prr(nzb+1,:,:) )
650	DO i = nxlg, nxrg
651	DO j = nysg, nyng
652	local_pf(i,j,nzb+1) = prr(nzb+1,j,i) * hyrho(nzb+1)
653	ENDDO
654	ENDDO
655	ELSE
656	CALL exchange_horiz_2d( prr_av(nzb+1,:,:) )
657	DO i = nxlg, nxrg
658	DO j = nysg, nyng
659	local_pf(i,j,nzb+1) = prr_av(nzb+1,j,i) * &
660	hyrho(nzb+1)
661	ENDDO
662	ENDDO
663	ENDIF
664	ENDIF
665	resorted = .TRUE.
666	two_d = .TRUE.
667	level_z(nzb+1) = zu(nzb+1)
668
669	CASE ( 'prr_xy', 'prr_xz', 'prr_yz' )
670	IF ( av == 0 ) THEN
671	CALL exchange_horiz( prr, nbgp )
672	DO i = nxlg, nxrg
673	DO j = nysg, nyng
674	DO k = nzb, nzt+1
675	local_pf(i,j,k) = prr(k,j,i)
676	ENDDO
677	ENDDO
678	ENDDO
679	ELSE
680	CALL exchange_horiz( prr_av, nbgp )
681	DO i = nxlg, nxrg
682	DO j = nysg, nyng
683	DO k = nzb, nzt+1
684	local_pf(i,j,k) = prr_av(k,j,i)
685	ENDDO
686	ENDDO
687	ENDDO
688	ENDIF
689	resorted = .TRUE.
690	IF ( mode == 'xy' ) level_z = zu
691
692	CASE ( 'pt_xy', 'pt_xz', 'pt_yz' )
693	IF ( av == 0 ) THEN
694	IF ( .NOT. cloud_physics ) THEN
695	to_be_resorted => pt
696	ELSE
697	DO i = nxlg, nxrg
698	DO j = nysg, nyng
699	DO k = nzb, nzt+1
700	local_pf(i,j,k) = pt(k,j,i) + l_d_cp * &
701	pt_d_t(k) * &
702	ql(k,j,i)
703	ENDDO
704	ENDDO
705	ENDDO
706	resorted = .TRUE.
707	ENDIF
708	ELSE
709	to_be_resorted => pt_av
710	ENDIF
711	IF ( mode == 'xy' ) level_z = zu
712
713	CASE ( 'q_xy', 'q_xz', 'q_yz' )
714	IF ( av == 0 ) THEN
715	to_be_resorted => q
716	ELSE
717	to_be_resorted => q_av
718	ENDIF
719	IF ( mode == 'xy' ) level_z = zu
720
721	CASE ( 'qc_xy', 'qc_xz', 'qc_yz' )
722	IF ( av == 0 ) THEN
723	to_be_resorted => qc
724	ELSE
725	to_be_resorted => qc_av
726	ENDIF
727	IF ( mode == 'xy' ) level_z = zu
728
729	CASE ( 'ql_xy', 'ql_xz', 'ql_yz' )
730	IF ( av == 0 ) THEN
731	to_be_resorted => ql
732	ELSE
733	to_be_resorted => ql_av
734	ENDIF
735	IF ( mode == 'xy' ) level_z = zu
736
737	CASE ( 'ql_c_xy', 'ql_c_xz', 'ql_c_yz' )
738	IF ( av == 0 ) THEN
739	to_be_resorted => ql_c
740	ELSE
741	to_be_resorted => ql_c_av
742	ENDIF
743	IF ( mode == 'xy' ) level_z = zu
744
745	CASE ( 'ql_v_xy', 'ql_v_xz', 'ql_v_yz' )
746	IF ( av == 0 ) THEN
747	to_be_resorted => ql_v
748	ELSE
749	to_be_resorted => ql_v_av
750	ENDIF
751	IF ( mode == 'xy' ) level_z = zu
752
753	CASE ( 'ql_vp_xy', 'ql_vp_xz', 'ql_vp_yz' )
754	IF ( av == 0 ) THEN
755	IF ( simulated_time >= particle_advection_start ) THEN
756	DO i = nxl, nxr
757	DO j = nys, nyn
758	DO k = nzb, nzt+1
759	number_of_particles = prt_count(k,j,i)
760	IF (number_of_particles <= 0) CYCLE
761	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
762	DO n = 1, number_of_particles
763	IF ( particles(n)%particle_mask ) THEN
764	tend(k,j,i) = tend(k,j,i) + &
765	particles(n)%weight_factor / &
766	prt_count(k,j,i)
767	ENDIF
768	ENDDO
769	ENDDO
770	ENDDO
771	ENDDO
772	CALL exchange_horiz( tend, nbgp )
773	ELSE
774	tend = 0.0_wp
775	ENDIF
776	DO i = nxlg, nxrg
777	DO j = nysg, nyng
778	DO k = nzb, nzt+1
779	local_pf(i,j,k) = tend(k,j,i)
780	ENDDO
781	ENDDO
782	ENDDO
783	resorted = .TRUE.
784	ELSE
785	CALL exchange_horiz( ql_vp_av, nbgp )
786	to_be_resorted => ql_vp
787	ENDIF
788	IF ( mode == 'xy' ) level_z = zu
789
790	CASE ( 'qr_xy', 'qr_xz', 'qr_yz' )
791	IF ( av == 0 ) THEN
792	to_be_resorted => qr
793	ELSE
794	to_be_resorted => qr_av
795	ENDIF
796	IF ( mode == 'xy' ) level_z = zu
797
798	CASE ( 'qsws*_xy' ) ! 2d-array
799	IF ( av == 0 ) THEN
800	DO i = nxlg, nxrg
801	DO j = nysg, nyng
802	local_pf(i,j,nzb+1) = qsws(j,i)
803	ENDDO
804	ENDDO
805	ELSE
806	DO i = nxlg, nxrg
807	DO j = nysg, nyng
808	local_pf(i,j,nzb+1) = qsws_av(j,i)
809	ENDDO
810	ENDDO
811	ENDIF
812	resorted = .TRUE.
813	two_d = .TRUE.
814	level_z(nzb+1) = zu(nzb+1)
815
816	CASE ( 'qsws_eb*_xy' ) ! 2d-array
817	IF ( av == 0 ) THEN
818	DO i = nxlg, nxrg
819	DO j = nysg, nyng
820	local_pf(i,j,nzb+1) = qsws_eb(j,i)
821	ENDDO
822	ENDDO
823	ELSE
824	DO i = nxlg, nxrg
825	DO j = nysg, nyng
826	local_pf(i,j,nzb+1) = qsws_eb_av(j,i)
827	ENDDO
828	ENDDO
829	ENDIF
830	resorted = .TRUE.
831	two_d = .TRUE.
832	level_z(nzb+1) = zu(nzb+1)
833
834	CASE ( 'qsws_liq_eb*_xy' ) ! 2d-array
835	IF ( av == 0 ) THEN
836	DO i = nxlg, nxrg
837	DO j = nysg, nyng
838	local_pf(i,j,nzb+1) = qsws_liq_eb(j,i)
839	ENDDO
840	ENDDO
841	ELSE
842	DO i = nxlg, nxrg
843	DO j = nysg, nyng
844	local_pf(i,j,nzb+1) = qsws_liq_eb_av(j,i)
845	ENDDO
846	ENDDO
847	ENDIF
848	resorted = .TRUE.
849	two_d = .TRUE.
850	level_z(nzb+1) = zu(nzb+1)
851
852	CASE ( 'qsws_soil_eb*_xy' ) ! 2d-array
853	IF ( av == 0 ) THEN
854	DO i = nxlg, nxrg
855	DO j = nysg, nyng
856	local_pf(i,j,nzb+1) = qsws_soil_eb(j,i)
857	ENDDO
858	ENDDO
859	ELSE
860	DO i = nxlg, nxrg
861	DO j = nysg, nyng
862	local_pf(i,j,nzb+1) = qsws_soil_eb_av(j,i)
863	ENDDO
864	ENDDO
865	ENDIF
866	resorted = .TRUE.
867	two_d = .TRUE.
868	level_z(nzb+1) = zu(nzb+1)
869
870	CASE ( 'qsws_veg_eb*_xy' ) ! 2d-array
871	IF ( av == 0 ) THEN
872	DO i = nxlg, nxrg
873	DO j = nysg, nyng
874	local_pf(i,j,nzb+1) = qsws_veg_eb(j,i)
875	ENDDO
876	ENDDO
877	ELSE
878	DO i = nxlg, nxrg
879	DO j = nysg, nyng
880	local_pf(i,j,nzb+1) = qsws_veg_eb_av(j,i)
881	ENDDO
882	ENDDO
883	ENDIF
884	resorted = .TRUE.
885	two_d = .TRUE.
886	level_z(nzb+1) = zu(nzb+1)
887
888	CASE ( 'qv_xy', 'qv_xz', 'qv_yz' )
889	IF ( av == 0 ) THEN
890	DO i = nxlg, nxrg
891	DO j = nysg, nyng
892	DO k = nzb, nzt+1
893	local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
894	ENDDO
895	ENDDO
896	ENDDO
897	resorted = .TRUE.
898	ELSE
899	to_be_resorted => qv_av
900	ENDIF
901	IF ( mode == 'xy' ) level_z = zu
902
903	CASE ( 'rad_net*_xy' ) ! 2d-array
904	IF ( av == 0 ) THEN
905	DO i = nxlg, nxrg
906	DO j = nysg, nyng
907	local_pf(i,j,nzb+1) = rad_net(j,i)
908	ENDDO
909	ENDDO
910	ELSE
911	DO i = nxlg, nxrg
912	DO j = nysg, nyng
913	local_pf(i,j,nzb+1) = rad_net_av(j,i)
914	ENDDO
915	ENDDO
916	ENDIF
917	resorted = .TRUE.
918	two_d = .TRUE.
919	level_z(nzb+1) = zu(nzb+1)
920
921
922	CASE ( 'rad_lw_in_xy', 'rad_lw_in_xz', 'rad_lw_in_yz' )
923	IF ( av == 0 ) THEN
924	to_be_resorted => rad_lw_in
925	ELSE
926	to_be_resorted => rad_lw_in_av
927	ENDIF
928
929	CASE ( 'rad_lw_out_xy', 'rad_lw_out_xz', 'rad_lw_out_yz' )
930	IF ( av == 0 ) THEN
931	to_be_resorted => rad_lw_out
932	ELSE
933	to_be_resorted => rad_lw_out_av
934	ENDIF
935
936	CASE ( 'rad_sw_in_xy', 'rad_sw_in_xz', 'rad_sw_in_yz' )
937	IF ( av == 0 ) THEN
938	to_be_resorted => rad_sw_in
939	ELSE
940	to_be_resorted => rad_sw_in_av
941	ENDIF
942
943	CASE ( 'rad_sw_out_xy', 'rad_sw_out_xz', 'rad_sw_out_yz' )
944	IF ( av == 0 ) THEN
945	to_be_resorted => rad_sw_out
946	ELSE
947	to_be_resorted => rad_sw_out_av
948	ENDIF
949
950	CASE ( 'rho_xy', 'rho_xz', 'rho_yz' )
951	IF ( av == 0 ) THEN
952	to_be_resorted => rho
953	ELSE
954	to_be_resorted => rho_av
955	ENDIF
956
957	CASE ( 'r_a*_xy' ) ! 2d-array
958	IF ( av == 0 ) THEN
959	DO i = nxlg, nxrg
960	DO j = nysg, nyng
961	local_pf(i,j,nzb+1) = r_a(j,i)
962	ENDDO
963	ENDDO
964	ELSE
965	DO i = nxlg, nxrg
966	DO j = nysg, nyng
967	local_pf(i,j,nzb+1) = r_a_av(j,i)
968	ENDDO
969	ENDDO
970	ENDIF
971	resorted = .TRUE.
972	two_d = .TRUE.
973	level_z(nzb+1) = zu(nzb+1)
974
975	CASE ( 'r_s*_xy' ) ! 2d-array
976	IF ( av == 0 ) THEN
977	DO i = nxlg, nxrg
978	DO j = nysg, nyng
979	local_pf(i,j,nzb+1) = r_s(j,i)
980	ENDDO
981	ENDDO
982	ELSE
983	DO i = nxlg, nxrg
984	DO j = nysg, nyng
985	local_pf(i,j,nzb+1) = r_s_av(j,i)
986	ENDDO
987	ENDDO
988	ENDIF
989	resorted = .TRUE.
990	two_d = .TRUE.
991	level_z(nzb+1) = zu(nzb+1)
992
993	CASE ( 's_xy', 's_xz', 's_yz' )
994	IF ( av == 0 ) THEN
995	to_be_resorted => q
996	ELSE
997	to_be_resorted => s_av
998	ENDIF
999
1000	CASE ( 'sa_xy', 'sa_xz', 'sa_yz' )
1001	IF ( av == 0 ) THEN
1002	to_be_resorted => sa
1003	ELSE
1004	to_be_resorted => sa_av
1005	ENDIF
1006
1007	CASE ( 'shf*_xy' ) ! 2d-array
1008	IF ( av == 0 ) THEN
1009	DO i = nxlg, nxrg
1010	DO j = nysg, nyng
1011	local_pf(i,j,nzb+1) = shf(j,i)
1012	ENDDO
1013	ENDDO
1014	ELSE
1015	DO i = nxlg, nxrg
1016	DO j = nysg, nyng
1017	local_pf(i,j,nzb+1) = shf_av(j,i)
1018	ENDDO
1019	ENDDO
1020	ENDIF
1021	resorted = .TRUE.
1022	two_d = .TRUE.
1023	level_z(nzb+1) = zu(nzb+1)
1024
1025	CASE ( 'shf_eb*_xy' ) ! 2d-array
1026	IF ( av == 0 ) THEN
1027	DO i = nxlg, nxrg
1028	DO j = nysg, nyng
1029	local_pf(i,j,nzb+1) = shf_eb(j,i)
1030	ENDDO
1031	ENDDO
1032	ELSE
1033	DO i = nxlg, nxrg
1034	DO j = nysg, nyng
1035	local_pf(i,j,nzb+1) = shf_eb_av(j,i)
1036	ENDDO
1037	ENDDO
1038	ENDIF
1039	resorted = .TRUE.
1040	two_d = .TRUE.
1041	level_z(nzb+1) = zu(nzb+1)
1042
1043	CASE ( 't*_xy' ) ! 2d-array
1044	IF ( av == 0 ) THEN
1045	DO i = nxlg, nxrg
1046	DO j = nysg, nyng
1047	local_pf(i,j,nzb+1) = ts(j,i)
1048	ENDDO
1049	ENDDO
1050	ELSE
1051	DO i = nxlg, nxrg
1052	DO j = nysg, nyng
1053	local_pf(i,j,nzb+1) = ts_av(j,i)
1054	ENDDO
1055	ENDDO
1056	ENDIF
1057	resorted = .TRUE.
1058	two_d = .TRUE.
1059	level_z(nzb+1) = zu(nzb+1)
1060
1061	CASE ( 't_soil_xy', 't_soil_xz', 't_soil_yz' )
1062	nzb_do = nzb_soil
1063	nzt_do = nzt_soil
1064	IF ( av == 0 ) THEN
1065	to_be_resorted => t_soil
1066	ELSE
1067	to_be_resorted => t_soil_av
1068	ENDIF
1069	IF ( mode == 'xy' ) level_z = zs
1070
1071	CASE ( 'u_xy', 'u_xz', 'u_yz' )
1072	IF ( av == 0 ) THEN
1073	to_be_resorted => u
1074	ELSE
1075	to_be_resorted => u_av
1076	ENDIF
1077	IF ( mode == 'xy' ) level_z = zu
1078	!
1079	!-- Substitute the values generated by "mirror" boundary condition
1080	!-- at the bottom boundary by the real surface values.
1081	IF ( do2d(av,if) == 'u_xz' .OR. do2d(av,if) == 'u_yz' ) THEN
1082	IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0_wp
1083	ENDIF
1084
1085	CASE ( 'u*_xy' ) ! 2d-array
1086	IF ( av == 0 ) THEN
1087	DO i = nxlg, nxrg
1088	DO j = nysg, nyng
1089	local_pf(i,j,nzb+1) = us(j,i)
1090	ENDDO
1091	ENDDO
1092	ELSE
1093	DO i = nxlg, nxrg
1094	DO j = nysg, nyng
1095	local_pf(i,j,nzb+1) = us_av(j,i)
1096	ENDDO
1097	ENDDO
1098	ENDIF
1099	resorted = .TRUE.
1100	two_d = .TRUE.
1101	level_z(nzb+1) = zu(nzb+1)
1102
1103	CASE ( 'v_xy', 'v_xz', 'v_yz' )
1104	IF ( av == 0 ) THEN
1105	to_be_resorted => v
1106	ELSE
1107	to_be_resorted => v_av
1108	ENDIF
1109	IF ( mode == 'xy' ) level_z = zu
1110	!
1111	!-- Substitute the values generated by "mirror" boundary condition
1112	!-- at the bottom boundary by the real surface values.
1113	IF ( do2d(av,if) == 'v_xz' .OR. do2d(av,if) == 'v_yz' ) THEN
1114	IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0_wp
1115	ENDIF
1116
1117	CASE ( 'vpt_xy', 'vpt_xz', 'vpt_yz' )
1118	IF ( av == 0 ) THEN
1119	to_be_resorted => vpt
1120	ELSE
1121	to_be_resorted => vpt_av
1122	ENDIF
1123	IF ( mode == 'xy' ) level_z = zu
1124
1125	CASE ( 'w_xy', 'w_xz', 'w_yz' )
1126	IF ( av == 0 ) THEN
1127	to_be_resorted => w
1128	ELSE
1129	to_be_resorted => w_av
1130	ENDIF
1131	IF ( mode == 'xy' ) level_z = zw
1132
1133	CASE ( 'z0*_xy' ) ! 2d-array
1134	IF ( av == 0 ) THEN
1135	DO i = nxlg, nxrg
1136	DO j = nysg, nyng
1137	local_pf(i,j,nzb+1) = z0(j,i)
1138	ENDDO
1139	ENDDO
1140	ELSE
1141	DO i = nxlg, nxrg
1142	DO j = nysg, nyng
1143	local_pf(i,j,nzb+1) = z0_av(j,i)
1144	ENDDO
1145	ENDDO
1146	ENDIF
1147	resorted = .TRUE.
1148	two_d = .TRUE.
1149	level_z(nzb+1) = zu(nzb+1)
1150
1151	CASE ( 'z0h*_xy' ) ! 2d-array
1152	IF ( av == 0 ) THEN
1153	DO i = nxlg, nxrg
1154	DO j = nysg, nyng
1155	local_pf(i,j,nzb+1) = z0h(j,i)
1156	ENDDO
1157	ENDDO
1158	ELSE
1159	DO i = nxlg, nxrg
1160	DO j = nysg, nyng
1161	local_pf(i,j,nzb+1) = z0h_av(j,i)
1162	ENDDO
1163	ENDDO
1164	ENDIF
1165	resorted = .TRUE.
1166	two_d = .TRUE.
1167	level_z(nzb+1) = zu(nzb+1)
1168
1169	CASE DEFAULT
1170	!
1171	!-- User defined quantity
1172	CALL user_data_output_2d( av, do2d(av,if), found, grid, &
1173	local_pf, two_d, nzb_do, nzt_do )
1174	resorted = .TRUE.
1175
1176	IF ( grid == 'zu' ) THEN
1177	IF ( mode == 'xy' ) level_z = zu
1178	ELSEIF ( grid == 'zw' ) THEN
1179	IF ( mode == 'xy' ) level_z = zw
1180	ELSEIF ( grid == 'zu1' ) THEN
1181	IF ( mode == 'xy' ) level_z(nzb+1) = zu(nzb+1)
1182	ELSEIF ( grid == 'zs' ) THEN
1183	IF ( mode == 'xy' ) level_z = zs
1184	ENDIF
1185
1186	IF ( .NOT. found ) THEN
1187	message_string = 'no output provided for: ' // &
1188	TRIM( do2d(av,if) )
1189	CALL message( 'data_output_2d', 'PA0181', 0, 0, 0, 6, 0 )
1190	ENDIF
1191
1192	END SELECT
1193
1194	!
1195	!-- Resort the array to be output, if not done above
1196	IF ( .NOT. resorted ) THEN
1197	DO i = nxlg, nxrg
1198	DO j = nysg, nyng
1199	DO k = nzb_do, nzt_do
1200	local_pf(i,j,k) = to_be_resorted(k,j,i)
1201	ENDDO
1202	ENDDO
1203	ENDDO
1204	ENDIF
1205
1206	!
1207	!-- Output of the individual cross-sections, depending on the cross-
1208	!-- section mode chosen.
1209	is = 1
1210	loop1: DO WHILE ( section(is,s) /= -9999 .OR. two_d )
1211
1212	SELECT CASE ( mode )
1213
1214	CASE ( 'xy' )
1215	!
1216	!-- Determine the cross section index
1217	IF ( two_d ) THEN
1218	layer_xy = nzb+1
1219	ELSE
1220	layer_xy = section(is,s)
1221	ENDIF
1222
1223	!
1224	!-- Exit the loop for layers beyond the data output domain
1225	!-- (used for soil model)
1226	IF ( layer_xy .GT. nzt_do ) THEN
1227	EXIT loop1
1228	ENDIF
1229
1230	!
1231	!-- Update the netCDF xy cross section time axis.
1232	!-- In case of parallel output, this is only done by PE0
1233	!-- to increase the performance.
1234	IF ( simulated_time /= do2d_xy_last_time(av) ) THEN
1235	do2d_xy_time_count(av) = do2d_xy_time_count(av) + 1
1236	do2d_xy_last_time(av) = simulated_time
1237	IF ( myid == 0 ) THEN
1238	IF ( .NOT. data_output_2d_on_each_pe &
1239	.OR. netcdf_data_format > 4 ) &
1240	THEN
1241	#if defined( __netcdf )
1242	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1243	id_var_time_xy(av), &
1244	(/ time_since_reference_point /), &
1245	start = (/ do2d_xy_time_count(av) /), &
1246	count = (/ 1 /) )
1247	CALL handle_netcdf_error( 'data_output_2d', 53 )
1248	#endif
1249	ENDIF
1250	ENDIF
1251	ENDIF
1252	!
1253	!-- If required, carry out averaging along z
1254	IF ( section(is,s) == -1 .AND. .NOT. two_d ) THEN
1255
1256	local_2d = 0.0_wp
1257	!
1258	!-- Carry out the averaging (all data are on the PE)
1259	DO k = nzb_do, nzt_do
1260	DO j = nysg, nyng
1261	DO i = nxlg, nxrg
1262	local_2d(i,j) = local_2d(i,j) + local_pf(i,j,k)
1263	ENDDO
1264	ENDDO
1265	ENDDO
1266
1267	local_2d = local_2d / ( nzt_do - nzb_do + 1.0_wp)
1268
1269	ELSE
1270	!
1271	!-- Just store the respective section on the local array
1272	local_2d = local_pf(:,:,layer_xy)
1273
1274	ENDIF
1275
1276	#if defined( __parallel )
1277	IF ( netcdf_data_format > 4 ) THEN
1278	!
1279	!-- Parallel output in netCDF4/HDF5 format.
1280	IF ( two_d ) THEN
1281	iis = 1
1282	ELSE
1283	iis = is
1284	ENDIF
1285
1286	#if defined( __netcdf )
1287	!
1288	!-- For parallel output, all cross sections are first stored
1289	!-- here on a local array and will be written to the output
1290	!-- file afterwards to increase the performance.
1291	DO i = nxlg, nxrg
1292	DO j = nysg, nyng
1293	local_2d_sections(i,j,iis) = local_2d(i,j)
1294	ENDDO
1295	ENDDO
1296	#endif
1297	ELSE
1298
1299	IF ( data_output_2d_on_each_pe ) THEN
1300	!
1301	!-- Output of partial arrays on each PE
1302	#if defined( __netcdf )
1303	IF ( myid == 0 ) THEN
1304	WRITE ( 21 ) time_since_reference_point, &
1305	do2d_xy_time_count(av), av
1306	ENDIF
1307	#endif
1308	DO i = 0, io_blocks-1
1309	IF ( i == io_group ) THEN
1310	WRITE ( 21 ) nxlg, nxrg, nysg, nyng, nysg, nyng
1311	WRITE ( 21 ) local_2d
1312	ENDIF
1313	#if defined( __parallel )
1314	CALL MPI_BARRIER( comm2d, ierr )
1315	#endif
1316	ENDDO
1317
1318	ELSE
1319	!
1320	!-- PE0 receives partial arrays from all processors and
1321	!-- then outputs them. Here a barrier has to be set,
1322	!-- because otherwise "-MPI- FATAL: Remote protocol queue
1323	!-- full" may occur.
1324	CALL MPI_BARRIER( comm2d, ierr )
1325
1326	ngp = ( nxrg-nxlg+1 ) * ( nyng-nysg+1 )
1327	IF ( myid == 0 ) THEN
1328	!
1329	!-- Local array can be relocated directly.
1330	total_2d(nxlg:nxrg,nysg:nyng) = local_2d
1331	!
1332	!-- Receive data from all other PEs.
1333	DO n = 1, numprocs-1
1334	!
1335	!-- Receive index limits first, then array.
1336	!-- Index limits are received in arbitrary order from
1337	!-- the PEs.
1338	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
1339	MPI_ANY_SOURCE, 0, comm2d, &
1340	status, ierr )
1341	sender = status(MPI_SOURCE)
1342	DEALLOCATE( local_2d )
1343	ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
1344	CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
1345	MPI_REAL, sender, 1, comm2d, &
1346	status, ierr )
1347	total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
1348	ENDDO
1349	!
1350	!-- Relocate the local array for the next loop increment
1351	DEALLOCATE( local_2d )
1352	ALLOCATE( local_2d(nxlg:nxrg,nysg:nyng) )
1353
1354	#if defined( __netcdf )
1355	IF ( two_d ) THEN
1356	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1357	id_var_do2d(av,if), &
1358	total_2d(0:nx+1,0:ny+1), &
1359	start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
1360	count = (/ nx+2, ny+2, 1, 1 /) )
1361	ELSE
1362	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1363	id_var_do2d(av,if), &
1364	total_2d(0:nx+1,0:ny+1), &
1365	start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
1366	count = (/ nx+2, ny+2, 1, 1 /) )
1367	ENDIF
1368	CALL handle_netcdf_error( 'data_output_2d', 54 )
1369	#endif
1370
1371	ELSE
1372	!
1373	!-- First send the local index limits to PE0
1374	ind(1) = nxlg; ind(2) = nxrg
1375	ind(3) = nysg; ind(4) = nyng
1376	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
1377	comm2d, ierr )
1378	!
1379	!-- Send data to PE0
1380	CALL MPI_SEND( local_2d(nxlg,nysg), ngp, &
1381	MPI_REAL, 0, 1, comm2d, ierr )
1382	ENDIF
1383	!
1384	!-- A barrier has to be set, because otherwise some PEs may
1385	!-- proceed too fast so that PE0 may receive wrong data on
1386	!-- tag 0
1387	CALL MPI_BARRIER( comm2d, ierr )
1388	ENDIF
1389
1390	ENDIF
1391	#else
1392	#if defined( __netcdf )
1393	IF ( two_d ) THEN
1394	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1395	id_var_do2d(av,if), &
1396	local_2d(nxl:nxr+1,nys:nyn+1), &
1397	start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
1398	count = (/ nx+2, ny+2, 1, 1 /) )
1399	ELSE
1400	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1401	id_var_do2d(av,if), &
1402	local_2d(nxl:nxr+1,nys:nyn+1), &
1403	start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
1404	count = (/ nx+2, ny+2, 1, 1 /) )
1405	ENDIF
1406	CALL handle_netcdf_error( 'data_output_2d', 447 )
1407	#endif
1408	#endif
1409	do2d_xy_n = do2d_xy_n + 1
1410	!
1411	!-- For 2D-arrays (e.g. u*) only one cross-section is available.
1412	!-- Hence exit loop of output levels.
1413	IF ( two_d ) THEN
1414	two_d = .FALSE.
1415	EXIT loop1
1416	ENDIF
1417
1418	CASE ( 'xz' )
1419	!
1420	!-- Update the netCDF xz cross section time axis.
1421	!-- In case of parallel output, this is only done by PE0
1422	!-- to increase the performance.
1423	IF ( simulated_time /= do2d_xz_last_time(av) ) THEN
1424	do2d_xz_time_count(av) = do2d_xz_time_count(av) + 1
1425	do2d_xz_last_time(av) = simulated_time
1426	IF ( myid == 0 ) THEN
1427	IF ( .NOT. data_output_2d_on_each_pe &
1428	.OR. netcdf_data_format > 4 ) &
1429	THEN
1430	#if defined( __netcdf )
1431	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
1432	id_var_time_xz(av), &
1433	(/ time_since_reference_point /), &
1434	start = (/ do2d_xz_time_count(av) /), &
1435	count = (/ 1 /) )
1436	CALL handle_netcdf_error( 'data_output_2d', 56 )
1437	#endif
1438	ENDIF
1439	ENDIF
1440	ENDIF
1441
1442	!
1443	!-- If required, carry out averaging along y
1444	IF ( section(is,s) == -1 ) THEN
1445
1446	ALLOCATE( local_2d_l(nxlg:nxrg,nzb_do:nzt_do) )
1447	local_2d_l = 0.0_wp
1448	ngp = ( nxrg-nxlg + 1 ) * ( nzt_do-nzb_do + 1 )
1449	!
1450	!-- First local averaging on the PE
1451	DO k = nzb_do, nzt_do
1452	DO j = nys, nyn
1453	DO i = nxlg, nxrg
1454	local_2d_l(i,k) = local_2d_l(i,k) + &
1455	local_pf(i,j,k)
1456	ENDDO
1457	ENDDO
1458	ENDDO
1459	#if defined( __parallel )
1460	!
1461	!-- Now do the averaging over all PEs along y
1462	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
1463	CALL MPI_ALLREDUCE( local_2d_l(nxlg,nzb_do), &
1464	local_2d(nxlg,nzb_do), ngp, MPI_REAL, &
1465	MPI_SUM, comm1dy, ierr )
1466	#else
1467	local_2d = local_2d_l
1468	#endif
1469	local_2d = local_2d / ( ny + 1.0_wp )
1470
1471	DEALLOCATE( local_2d_l )
1472
1473	ELSE
1474	!
1475	!-- Just store the respective section on the local array
1476	!-- (but only if it is available on this PE!)
1477	IF ( section(is,s) >= nys .AND. section(is,s) <= nyn ) &
1478	THEN
1479	local_2d = local_pf(:,section(is,s),nzb_do:nzt_do)
1480	ENDIF
1481
1482	ENDIF
1483
1484	#if defined( __parallel )
1485	IF ( netcdf_data_format > 4 ) THEN
1486	!
1487	!-- Output in netCDF4/HDF5 format.
1488	!-- Output only on those PEs where the respective cross
1489	!-- sections reside. Cross sections averaged along y are
1490	!-- output on the respective first PE along y (myidy=0).
1491	IF ( ( section(is,s) >= nys .AND. &
1492	section(is,s) <= nyn ) .OR. &
1493	( section(is,s) == -1 .AND. myidy == 0 ) ) THEN
1494	#if defined( __netcdf )
1495	!
1496	!-- For parallel output, all cross sections are first
1497	!-- stored here on a local array and will be written to the
1498	!-- output file afterwards to increase the performance.
1499	DO i = nxlg, nxrg
1500	DO k = nzb_do, nzt_do
1501	local_2d_sections_l(i,is,k) = local_2d(i,k)
1502	ENDDO
1503	ENDDO
1504	#endif
1505	ENDIF
1506
1507	ELSE
1508
1509	IF ( data_output_2d_on_each_pe ) THEN
1510	!
1511	!-- Output of partial arrays on each PE. If the cross
1512	!-- section does not reside on the PE, output special
1513	!-- index values.
1514	#if defined( __netcdf )
1515	IF ( myid == 0 ) THEN
1516	WRITE ( 22 ) time_since_reference_point, &
1517	do2d_xz_time_count(av), av
1518	ENDIF
1519	#endif
1520	DO i = 0, io_blocks-1
1521	IF ( i == io_group ) THEN
1522	IF ( ( section(is,s) >= nys .AND. &
1523	section(is,s) <= nyn ) .OR. &
1524	( section(is,s) == -1 .AND. &
1525	nys-1 == -1 ) ) &
1526	THEN
1527	WRITE (22) nxlg, nxrg, nzb_do, nzt_do, nzb, nzt+1
1528	WRITE (22) local_2d
1529	ELSE
1530	WRITE (22) -1, -1, -1, -1, -1, -1
1531	ENDIF
1532	ENDIF
1533	#if defined( __parallel )
1534	CALL MPI_BARRIER( comm2d, ierr )
1535	#endif
1536	ENDDO
1537
1538	ELSE
1539	!
1540	!-- PE0 receives partial arrays from all processors of the
1541	!-- respective cross section and outputs them. Here a
1542	!-- barrier has to be set, because otherwise
1543	!-- "-MPI- FATAL: Remote protocol queue full" may occur.
1544	CALL MPI_BARRIER( comm2d, ierr )
1545
1546	ngp = ( nxrg-nxlg + 1 ) * ( nzt_do-nzb_do + 1 )
1547	IF ( myid == 0 ) THEN
1548	!
1549	!-- Local array can be relocated directly.
1550	IF ( ( section(is,s) >= nys .AND. &
1551	section(is,s) <= nyn ) .OR. &
1552	( section(is,s) == -1 .AND. nys-1 == -1 ) ) &
1553	THEN
1554	total_2d(nxlg:nxrg,nzb_do:nzt_do) = local_2d
1555	ENDIF
1556	!
1557	!-- Receive data from all other PEs.
1558	DO n = 1, numprocs-1
1559	!
1560	!-- Receive index limits first, then array.
1561	!-- Index limits are received in arbitrary order from
1562	!-- the PEs.
1563	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
1564	MPI_ANY_SOURCE, 0, comm2d, &
1565	status, ierr )
1566	!
1567	!-- Not all PEs have data for XZ-cross-section.
1568	IF ( ind(1) /= -9999 ) THEN
1569	sender = status(MPI_SOURCE)
1570	DEALLOCATE( local_2d )
1571	ALLOCATE( local_2d(ind(1):ind(2), &
1572	ind(3):ind(4)) )
1573	CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
1574	MPI_REAL, sender, 1, comm2d, &
1575	status, ierr )
1576	total_2d(ind(1):ind(2),ind(3):ind(4)) = &
1577	local_2d
1578	ENDIF
1579	ENDDO
1580	!
1581	!-- Relocate the local array for the next loop increment
1582	DEALLOCATE( local_2d )
1583	ALLOCATE( local_2d(nxlg:nxrg,nzb_do:nzt_do) )
1584
1585	#if defined( __netcdf )
1586	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
1587	id_var_do2d(av,if), &
1588	total_2d(0:nx+1,nzb_do:nzt_do),&
1589	start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
1590	count = (/ nx+2, 1, nzt_do-nzb_do+1, 1 /) )
1591	CALL handle_netcdf_error( 'data_output_2d', 58 )
1592	#endif
1593
1594	ELSE
1595	!
1596	!-- If the cross section resides on the PE, send the
1597	!-- local index limits, otherwise send -9999 to PE0.
1598	IF ( ( section(is,s) >= nys .AND. &
1599	section(is,s) <= nyn ) .OR. &
1600	( section(is,s) == -1 .AND. nys-1 == -1 ) ) &
1601	THEN
1602	ind(1) = nxlg; ind(2) = nxrg
1603	ind(3) = nzb_do; ind(4) = nzt_do
1604	ELSE
1605	ind(1) = -9999; ind(2) = -9999
1606	ind(3) = -9999; ind(4) = -9999
1607	ENDIF
1608	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
1609	comm2d, ierr )
1610	!
1611	!-- If applicable, send data to PE0.
1612	IF ( ind(1) /= -9999 ) THEN
1613	CALL MPI_SEND( local_2d(nxlg,nzb_do), ngp, &
1614	MPI_REAL, 0, 1, comm2d, ierr )
1615	ENDIF
1616	ENDIF
1617	!
1618	!-- A barrier has to be set, because otherwise some PEs may
1619	!-- proceed too fast so that PE0 may receive wrong data on
1620	!-- tag 0
1621	CALL MPI_BARRIER( comm2d, ierr )
1622	ENDIF
1623
1624	ENDIF
1625	#else
1626	#if defined( __netcdf )
1627	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
1628	id_var_do2d(av,if), &
1629	local_2d(nxl:nxr+1,nzb_do:nzt_do), &
1630	start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
1631	count = (/ nx+2, 1, nzt_do-nzb_do+1, 1 /) )
1632	CALL handle_netcdf_error( 'data_output_2d', 451 )
1633	#endif
1634	#endif
1635	do2d_xz_n = do2d_xz_n + 1
1636
1637	CASE ( 'yz' )
1638	!
1639	!-- Update the netCDF yz cross section time axis.
1640	!-- In case of parallel output, this is only done by PE0
1641	!-- to increase the performance.
1642	IF ( simulated_time /= do2d_yz_last_time(av) ) THEN
1643	do2d_yz_time_count(av) = do2d_yz_time_count(av) + 1
1644	do2d_yz_last_time(av) = simulated_time
1645	IF ( myid == 0 ) THEN
1646	IF ( .NOT. data_output_2d_on_each_pe &
1647	.OR. netcdf_data_format > 4 ) &
1648	THEN
1649	#if defined( __netcdf )
1650	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
1651	id_var_time_yz(av), &
1652	(/ time_since_reference_point /), &
1653	start = (/ do2d_yz_time_count(av) /), &
1654	count = (/ 1 /) )
1655	CALL handle_netcdf_error( 'data_output_2d', 59 )
1656	#endif
1657	ENDIF
1658	ENDIF
1659	ENDIF
1660
1661	!
1662	!-- If required, carry out averaging along x
1663	IF ( section(is,s) == -1 ) THEN
1664
1665	ALLOCATE( local_2d_l(nysg:nyng,nzb_do:nzt_do) )
1666	local_2d_l = 0.0_wp
1667	ngp = ( nyng-nysg+1 ) * ( nzt_do-nzb_do+1 )
1668	!
1669	!-- First local averaging on the PE
1670	DO k = nzb_do, nzt_do
1671	DO j = nysg, nyng
1672	DO i = nxl, nxr
1673	local_2d_l(j,k) = local_2d_l(j,k) + &
1674	local_pf(i,j,k)
1675	ENDDO
1676	ENDDO
1677	ENDDO
1678	#if defined( __parallel )
1679	!
1680	!-- Now do the averaging over all PEs along x
1681	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
1682	CALL MPI_ALLREDUCE( local_2d_l(nysg,nzb_do), &
1683	local_2d(nysg,nzb_do), ngp, MPI_REAL, &
1684	MPI_SUM, comm1dx, ierr )
1685	#else
1686	local_2d = local_2d_l
1687	#endif
1688	local_2d = local_2d / ( nx + 1.0_wp )
1689
1690	DEALLOCATE( local_2d_l )
1691
1692	ELSE
1693	!
1694	!-- Just store the respective section on the local array
1695	!-- (but only if it is available on this PE!)
1696	IF ( section(is,s) >= nxl .AND. section(is,s) <= nxr ) &
1697	THEN
1698	local_2d = local_pf(section(is,s),:,nzb_do:nzt_do)
1699	ENDIF
1700
1701	ENDIF
1702
1703	#if defined( __parallel )
1704	IF ( netcdf_data_format > 4 ) THEN
1705	!
1706	!-- Output in netCDF4/HDF5 format.
1707	!-- Output only on those PEs where the respective cross
1708	!-- sections reside. Cross sections averaged along x are
1709	!-- output on the respective first PE along x (myidx=0).
1710	IF ( ( section(is,s) >= nxl .AND. &
1711	section(is,s) <= nxr ) .OR. &
1712	( section(is,s) == -1 .AND. myidx == 0 ) ) THEN
1713	#if defined( __netcdf )
1714	!
1715	!-- For parallel output, all cross sections are first
1716	!-- stored here on a local array and will be written to the
1717	!-- output file afterwards to increase the performance.
1718	DO j = nysg, nyng
1719	DO k = nzb_do, nzt_do
1720	local_2d_sections_l(is,j,k) = local_2d(j,k)
1721	ENDDO
1722	ENDDO
1723	#endif
1724	ENDIF
1725
1726	ELSE
1727
1728	IF ( data_output_2d_on_each_pe ) THEN
1729	!
1730	!-- Output of partial arrays on each PE. If the cross
1731	!-- section does not reside on the PE, output special
1732	!-- index values.
1733	#if defined( __netcdf )
1734	IF ( myid == 0 ) THEN
1735	WRITE ( 23 ) time_since_reference_point, &
1736	do2d_yz_time_count(av), av
1737	ENDIF
1738	#endif
1739	DO i = 0, io_blocks-1
1740	IF ( i == io_group ) THEN
1741	IF ( ( section(is,s) >= nxl .AND. &
1742	section(is,s) <= nxr ) .OR. &
1743	( section(is,s) == -1 .AND. &
1744	nxl-1 == -1 ) ) &
1745	THEN
1746	WRITE (23) nysg, nyng, nzb_do, nzt_do, nzb, nzt+1
1747	WRITE (23) local_2d
1748	ELSE
1749	WRITE (23) -1, -1, -1, -1, -1, -1
1750	ENDIF
1751	ENDIF
1752	#if defined( __parallel )
1753	CALL MPI_BARRIER( comm2d, ierr )
1754	#endif
1755	ENDDO
1756
1757	ELSE
1758	!
1759	!-- PE0 receives partial arrays from all processors of the
1760	!-- respective cross section and outputs them. Here a
1761	!-- barrier has to be set, because otherwise
1762	!-- "-MPI- FATAL: Remote protocol queue full" may occur.
1763	CALL MPI_BARRIER( comm2d, ierr )
1764
1765	ngp = ( nyng-nysg+1 ) * ( nzt_do-nzb_do+1 )
1766	IF ( myid == 0 ) THEN
1767	!
1768	!-- Local array can be relocated directly.
1769	IF ( ( section(is,s) >= nxl .AND. &
1770	section(is,s) <= nxr ) .OR. &
1771	( section(is,s) == -1 .AND. nxl-1 == -1 ) ) &
1772	THEN
1773	total_2d(nysg:nyng,nzb_do:nzt_do) = local_2d
1774	ENDIF
1775	!
1776	!-- Receive data from all other PEs.
1777	DO n = 1, numprocs-1
1778	!
1779	!-- Receive index limits first, then array.
1780	!-- Index limits are received in arbitrary order from
1781	!-- the PEs.
1782	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
1783	MPI_ANY_SOURCE, 0, comm2d, &
1784	status, ierr )
1785	!
1786	!-- Not all PEs have data for YZ-cross-section.
1787	IF ( ind(1) /= -9999 ) THEN
1788	sender = status(MPI_SOURCE)
1789	DEALLOCATE( local_2d )
1790	ALLOCATE( local_2d(ind(1):ind(2), &
1791	ind(3):ind(4)) )
1792	CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
1793	MPI_REAL, sender, 1, comm2d, &
1794	status, ierr )
1795	total_2d(ind(1):ind(2),ind(3):ind(4)) = &
1796	local_2d
1797	ENDIF
1798	ENDDO
1799	!
1800	!-- Relocate the local array for the next loop increment
1801	DEALLOCATE( local_2d )
1802	ALLOCATE( local_2d(nysg:nyng,nzb_do:nzt_do) )
1803
1804	#if defined( __netcdf )
1805	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
1806	id_var_do2d(av,if), &
1807	total_2d(0:ny+1,nzb_do:nzt_do),&
1808	start = (/ is, 1, 1, do2d_yz_time_count(av) /), &
1809	count = (/ 1, ny+2, nzt_do-nzb_do+1, 1 /) )
1810	CALL handle_netcdf_error( 'data_output_2d', 61 )
1811	#endif
1812
1813	ELSE
1814	!
1815	!-- If the cross section resides on the PE, send the
1816	!-- local index limits, otherwise send -9999 to PE0.
1817	IF ( ( section(is,s) >= nxl .AND. &
1818	section(is,s) <= nxr ) .OR. &
1819	( section(is,s) == -1 .AND. nxl-1 == -1 ) ) &
1820	THEN
1821	ind(1) = nysg; ind(2) = nyng
1822	ind(3) = nzb_do; ind(4) = nzt_do
1823	ELSE
1824	ind(1) = -9999; ind(2) = -9999
1825	ind(3) = -9999; ind(4) = -9999
1826	ENDIF
1827	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
1828	comm2d, ierr )
1829	!
1830	!-- If applicable, send data to PE0.
1831	IF ( ind(1) /= -9999 ) THEN
1832	CALL MPI_SEND( local_2d(nysg,nzb_do), ngp, &
1833	MPI_REAL, 0, 1, comm2d, ierr )
1834	ENDIF
1835	ENDIF
1836	!
1837	!-- A barrier has to be set, because otherwise some PEs may
1838	!-- proceed too fast so that PE0 may receive wrong data on
1839	!-- tag 0
1840	CALL MPI_BARRIER( comm2d, ierr )
1841	ENDIF
1842
1843	ENDIF
1844	#else
1845	#if defined( __netcdf )
1846	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
1847	id_var_do2d(av,if), &
1848	local_2d(nys:nyn+1,nzb_do:nzt_do), &
1849	start = (/ is, 1, 1, do2d_xz_time_count(av) /), &
1850	count = (/ 1, ny+2, nzt_do-nzb_do+1, 1 /) )
1851	CALL handle_netcdf_error( 'data_output_2d', 452 )
1852	#endif
1853	#endif
1854	do2d_yz_n = do2d_yz_n + 1
1855
1856	END SELECT
1857
1858	is = is + 1
1859	ENDDO loop1
1860
1861	!
1862	!-- For parallel output, all data were collected before on a local array
1863	!-- and are written now to the netcdf file. This must be done to increase
1864	!-- the performance of the parallel output.
1865	#if defined( __netcdf )
1866	IF ( netcdf_data_format > 4 ) THEN
1867
1868	SELECT CASE ( mode )
1869
1870	CASE ( 'xy' )
1871	IF ( two_d ) THEN
1872	iis = 1
1873	ELSE
1874	iis = is-1
1875	ENDIF
1876	!
1877	!-- Do not output redundant ghost point data except for the
1878	!-- boundaries of the total domain.
1879	IF ( nxr == nx .AND. nyn /= ny ) THEN
1880	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1881	id_var_do2d(av,if), &
1882	local_2d_sections(nxl:nxr+1, &
1883	nys:nyn,1:ns), &
1884	start = (/ nxl+1, nys+1, 1, &
1885	do2d_xy_time_count(av) /), &
1886	count = (/ nxr-nxl+2, &
1887	nyn-nys+1, ns, 1 &
1888	/) )
1889	ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN
1890	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1891	id_var_do2d(av,if), &
1892	local_2d_sections(nxl:nxr, &
1893	nys:nyn+1,1:ns), &
1894	start = (/ nxl+1, nys+1, 1, &
1895	do2d_xy_time_count(av) /), &
1896	count = (/ nxr-nxl+1, &
1897	nyn-nys+2, ns, 1 &
1898	/) )
1899	ELSEIF ( nxr == nx .AND. nyn == ny ) THEN
1900	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1901	id_var_do2d(av,if), &
1902	local_2d_sections(nxl:nxr+1, &
1903	nys:nyn+1,1:ns), &
1904	start = (/ nxl+1, nys+1, 1, &
1905	do2d_xy_time_count(av) /), &
1906	count = (/ nxr-nxl+2, &
1907	nyn-nys+2, ns, 1 &
1908	/) )
1909	ELSE
1910	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1911	id_var_do2d(av,if), &
1912	local_2d_sections(nxl:nxr, &
1913	nys:nyn,1:ns), &
1914	start = (/ nxl+1, nys+1, 1, &
1915	do2d_xy_time_count(av) /), &
1916	count = (/ nxr-nxl+1, &
1917	nyn-nys+1, ns, 1 &
1918	/) )
1919	ENDIF
1920
1921	CALL handle_netcdf_error( 'data_output_2d', 55 )
1922
1923	CASE ( 'xz' )
1924	!
1925	!-- First, all PEs get the information of all cross-sections.
1926	!-- Then the data are written to the output file by all PEs
1927	!-- while NF90_COLLECTIVE is set in subroutine
1928	!-- define_netcdf_header. Although redundant information are
1929	!-- written to the output file in that case, the performance
1930	!-- is significantly better compared to the case where only
1931	!-- the first row of PEs in x-direction (myidx = 0) is given
1932	!-- the output while NF90_INDEPENDENT is set.
1933	IF ( npey /= 1 ) THEN
1934
1935	#if defined( __parallel )
1936	!
1937	!-- Distribute data over all PEs along y
1938	ngp = ( nxrg-nxlg+1 ) * ( nzt_do-nzb_do+1 ) * ns
1939	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
1940	CALL MPI_ALLREDUCE( local_2d_sections_l(nxlg,1,nzb_do), &
1941	local_2d_sections(nxlg,1,nzb_do), &
1942	ngp, MPI_REAL, MPI_SUM, comm1dy, &
1943	ierr )
1944	#else
1945	local_2d_sections = local_2d_sections_l
1946	#endif
1947	ENDIF
1948	!
1949	!-- Do not output redundant ghost point data except for the
1950	!-- boundaries of the total domain.
1951	IF ( nxr == nx ) THEN
1952	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
1953	id_var_do2d(av,if), &
1954	local_2d_sections(nxl:nxr+1,1:ns, &
1955	nzb_do:nzt_do), &
1956	start = (/ nxl+1, 1, 1, &
1957	do2d_xz_time_count(av) /), &
1958	count = (/ nxr-nxl+2, ns, nzt_do-nzb_do+1, &
1959	1 /) )
1960	ELSE
1961	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
1962	id_var_do2d(av,if), &
1963	local_2d_sections(nxl:nxr,1:ns, &
1964	nzb_do:nzt_do), &
1965	start = (/ nxl+1, 1, 1, &
1966	do2d_xz_time_count(av) /), &
1967	count = (/ nxr-nxl+1, ns, nzt_do-nzb_do+1, &
1968	1 /) )
1969	ENDIF
1970
1971	CALL handle_netcdf_error( 'data_output_2d', 57 )
1972
1973	CASE ( 'yz' )
1974	!
1975	!-- First, all PEs get the information of all cross-sections.
1976	!-- Then the data are written to the output file by all PEs
1977	!-- while NF90_COLLECTIVE is set in subroutine
1978	!-- define_netcdf_header. Although redundant information are
1979	!-- written to the output file in that case, the performance
1980	!-- is significantly better compared to the case where only
1981	!-- the first row of PEs in y-direction (myidy = 0) is given
1982	!-- the output while NF90_INDEPENDENT is set.
1983	IF ( npex /= 1 ) THEN
1984
1985	#if defined( __parallel )
1986	!
1987	!-- Distribute data over all PEs along x
1988	ngp = ( nyng-nysg+1 ) * ( nzt-nzb + 2 ) * ns
1989	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
1990	CALL MPI_ALLREDUCE( local_2d_sections_l(1,nysg,nzb_do), &
1991	local_2d_sections(1,nysg,nzb_do), &
1992	ngp, MPI_REAL, MPI_SUM, comm1dx, &
1993	ierr )
1994	#else
1995	local_2d_sections = local_2d_sections_l
1996	#endif
1997	ENDIF
1998	!
1999	!-- Do not output redundant ghost point data except for the
2000	!-- boundaries of the total domain.
2001	IF ( nyn == ny ) THEN
2002	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
2003	id_var_do2d(av,if), &
2004	local_2d_sections(1:ns, &
2005	nys:nyn+1,nzb_do:nzt_do), &
2006	start = (/ 1, nys+1, 1, &
2007	do2d_yz_time_count(av) /), &
2008	count = (/ ns, nyn-nys+2, &
2009	nzt_do-nzb_do+1, 1 /) )
2010	ELSE
2011	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
2012	id_var_do2d(av,if), &
2013	local_2d_sections(1:ns,nys:nyn, &
2014	nzb_do:nzt_do), &
2015	start = (/ 1, nys+1, 1, &
2016	do2d_yz_time_count(av) /), &
2017	count = (/ ns, nyn-nys+1, &
2018	nzt_do-nzb_do+1, 1 /) )
2019	ENDIF
2020
2021	CALL handle_netcdf_error( 'data_output_2d', 60 )
2022
2023	CASE DEFAULT
2024	message_string = 'unknown cross-section: ' // TRIM( mode )
2025	CALL message( 'data_output_2d', 'PA0180', 1, 2, 0, 6, 0 )
2026
2027	END SELECT
2028
2029	ENDIF
2030	#endif
2031	ENDIF
2032
2033	if = if + 1
2034	l = MAX( 2, LEN_TRIM( do2d(av,if) ) )
2035	do2d_mode = do2d(av,if)(l-1:l)
2036
2037	ENDDO
2038
2039	!
2040	!-- Deallocate temporary arrays.
2041	IF ( ALLOCATED( level_z ) ) DEALLOCATE( level_z )
2042	IF ( netcdf_data_format > 4 ) THEN
2043	DEALLOCATE( local_pf, local_2d, local_2d_sections )
2044	IF( mode == 'xz' .OR. mode == 'yz' ) DEALLOCATE( local_2d_sections_l )
2045	ENDIF
2046	#if defined( __parallel )
2047	IF ( .NOT. data_output_2d_on_each_pe .AND. myid == 0 ) THEN
2048	DEALLOCATE( total_2d )
2049	ENDIF
2050	#endif
2051
2052	!
2053	!-- Close plot output file.
2054	file_id = 20 + s
2055
2056	IF ( data_output_2d_on_each_pe ) THEN
2057	DO i = 0, io_blocks-1
2058	IF ( i == io_group ) THEN
2059	CALL close_file( file_id )
2060	ENDIF
2061	#if defined( __parallel )
2062	CALL MPI_BARRIER( comm2d, ierr )
2063	#endif
2064	ENDDO
2065	ELSE
2066	IF ( myid == 0 ) CALL close_file( file_id )
2067	ENDIF
2068
2069	CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
2070
2071	END SUBROUTINE data_output_2d

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |