Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |