Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |