Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |