Home

Context Navigation

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

Last change on this file since 1551 was 1551, checked in by maronga, 9 years ago
land surface model released
Property svn:keywords set to `Id`
File size: 82.6 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |