Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |