Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |