Home

Context Navigation

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

Last change on this file since 1698 was 1692, checked in by maronga, 8 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 86.5 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	!
22	!
23	! Former revisions:
24	! -----------------
25	! $Id: data_output_2d.f90 1692 2015-10-26 16:29:17Z raasch $
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
956	CASE ( 'rad_lw_out_xy', 'rad_lw_out_xz', 'rad_lw_out_yz' )
957	IF ( av == 0 ) THEN
958	to_be_resorted => rad_lw_out
959	ELSE
960	to_be_resorted => rad_lw_out_av
961	ENDIF
962
963	CASE ( 'rad_lw_cs_hr_xy', 'rad_lw_cs_hr_xz', 'rad_lw_cs_hr_yz' )
964	IF ( av == 0 ) THEN
965	to_be_resorted => rad_lw_cs_hr
966	ELSE
967	to_be_resorted => rad_lw_cs_hr_av
968	ENDIF
969
970	CASE ( 'rad_lw_hr_xy', 'rad_lw_hr_xz', 'rad_lw_hr_yz' )
971	IF ( av == 0 ) THEN
972	to_be_resorted => rad_lw_hr
973	ELSE
974	to_be_resorted => rad_lw_hr_av
975	ENDIF
976
977	CASE ( 'rad_sw_in_xy', 'rad_sw_in_xz', 'rad_sw_in_yz' )
978	IF ( av == 0 ) THEN
979	to_be_resorted => rad_sw_in
980	ELSE
981	to_be_resorted => rad_sw_in_av
982	ENDIF
983
984	CASE ( 'rad_sw_out_xy', 'rad_sw_out_xz', 'rad_sw_out_yz' )
985	IF ( av == 0 ) THEN
986	to_be_resorted => rad_sw_out
987	ELSE
988	to_be_resorted => rad_sw_out_av
989	ENDIF
990
991	CASE ( 'rad_sw_cs_hr_xy', 'rad_sw_cs_hr_xz', 'rad_sw_cs_hr_yz' )
992	IF ( av == 0 ) THEN
993	to_be_resorted => rad_sw_cs_hr
994	ELSE
995	to_be_resorted => rad_sw_cs_hr_av
996	ENDIF
997
998	CASE ( 'rad_sw_hr_xy', 'rad_sw_hr_xz', 'rad_sw_hr_yz' )
999	IF ( av == 0 ) THEN
1000	to_be_resorted => rad_sw_hr
1001	ELSE
1002	to_be_resorted => rad_sw_hr_av
1003	ENDIF
1004
1005	CASE ( 'rho_xy', 'rho_xz', 'rho_yz' )
1006	IF ( av == 0 ) THEN
1007	to_be_resorted => rho
1008	ELSE
1009	to_be_resorted => rho_av
1010	ENDIF
1011
1012	CASE ( 'r_a*_xy' ) ! 2d-array
1013	IF ( av == 0 ) THEN
1014	DO i = nxlg, nxrg
1015	DO j = nysg, nyng
1016	local_pf(i,j,nzb+1) = r_a(j,i)
1017	ENDDO
1018	ENDDO
1019	ELSE
1020	DO i = nxlg, nxrg
1021	DO j = nysg, nyng
1022	local_pf(i,j,nzb+1) = r_a_av(j,i)
1023	ENDDO
1024	ENDDO
1025	ENDIF
1026	resorted = .TRUE.
1027	two_d = .TRUE.
1028	level_z(nzb+1) = zu(nzb+1)
1029
1030	CASE ( 'r_s*_xy' ) ! 2d-array
1031	IF ( av == 0 ) THEN
1032	DO i = nxlg, nxrg
1033	DO j = nysg, nyng
1034	local_pf(i,j,nzb+1) = r_s(j,i)
1035	ENDDO
1036	ENDDO
1037	ELSE
1038	DO i = nxlg, nxrg
1039	DO j = nysg, nyng
1040	local_pf(i,j,nzb+1) = r_s_av(j,i)
1041	ENDDO
1042	ENDDO
1043	ENDIF
1044	resorted = .TRUE.
1045	two_d = .TRUE.
1046	level_z(nzb+1) = zu(nzb+1)
1047
1048	CASE ( 's_xy', 's_xz', 's_yz' )
1049	IF ( av == 0 ) THEN
1050	to_be_resorted => q
1051	ELSE
1052	to_be_resorted => s_av
1053	ENDIF
1054
1055	CASE ( 'sa_xy', 'sa_xz', 'sa_yz' )
1056	IF ( av == 0 ) THEN
1057	to_be_resorted => sa
1058	ELSE
1059	to_be_resorted => sa_av
1060	ENDIF
1061
1062	CASE ( 'shf*_xy' ) ! 2d-array
1063	IF ( av == 0 ) THEN
1064	DO i = nxlg, nxrg
1065	DO j = nysg, nyng
1066	local_pf(i,j,nzb+1) = shf(j,i)
1067	ENDDO
1068	ENDDO
1069	ELSE
1070	DO i = nxlg, nxrg
1071	DO j = nysg, nyng
1072	local_pf(i,j,nzb+1) = shf_av(j,i)
1073	ENDDO
1074	ENDDO
1075	ENDIF
1076	resorted = .TRUE.
1077	two_d = .TRUE.
1078	level_z(nzb+1) = zu(nzb+1)
1079
1080	CASE ( 'shf_eb*_xy' ) ! 2d-array
1081	IF ( av == 0 ) THEN
1082	DO i = nxlg, nxrg
1083	DO j = nysg, nyng
1084	local_pf(i,j,nzb+1) = shf_eb(j,i)
1085	ENDDO
1086	ENDDO
1087	ELSE
1088	DO i = nxlg, nxrg
1089	DO j = nysg, nyng
1090	local_pf(i,j,nzb+1) = shf_eb_av(j,i)
1091	ENDDO
1092	ENDDO
1093	ENDIF
1094	resorted = .TRUE.
1095	two_d = .TRUE.
1096	level_z(nzb+1) = zu(nzb+1)
1097
1098	CASE ( 't*_xy' ) ! 2d-array
1099	IF ( av == 0 ) THEN
1100	DO i = nxlg, nxrg
1101	DO j = nysg, nyng
1102	local_pf(i,j,nzb+1) = ts(j,i)
1103	ENDDO
1104	ENDDO
1105	ELSE
1106	DO i = nxlg, nxrg
1107	DO j = nysg, nyng
1108	local_pf(i,j,nzb+1) = ts_av(j,i)
1109	ENDDO
1110	ENDDO
1111	ENDIF
1112	resorted = .TRUE.
1113	two_d = .TRUE.
1114	level_z(nzb+1) = zu(nzb+1)
1115
1116	CASE ( 't_soil_xy', 't_soil_xz', 't_soil_yz' )
1117	nzb_do = nzb_soil
1118	nzt_do = nzt_soil
1119	IF ( av == 0 ) THEN
1120	to_be_resorted => t_soil
1121	ELSE
1122	to_be_resorted => t_soil_av
1123	ENDIF
1124	IF ( mode == 'xy' ) level_z = zs
1125
1126	CASE ( 'u_xy', 'u_xz', 'u_yz' )
1127	IF ( av == 0 ) THEN
1128	to_be_resorted => u
1129	ELSE
1130	to_be_resorted => u_av
1131	ENDIF
1132	IF ( mode == 'xy' ) level_z = zu
1133	!
1134	!-- Substitute the values generated by "mirror" boundary condition
1135	!-- at the bottom boundary by the real surface values.
1136	IF ( do2d(av,if) == 'u_xz' .OR. do2d(av,if) == 'u_yz' ) THEN
1137	IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0_wp
1138	ENDIF
1139
1140	CASE ( 'u*_xy' ) ! 2d-array
1141	IF ( av == 0 ) THEN
1142	DO i = nxlg, nxrg
1143	DO j = nysg, nyng
1144	local_pf(i,j,nzb+1) = us(j,i)
1145	ENDDO
1146	ENDDO
1147	ELSE
1148	DO i = nxlg, nxrg
1149	DO j = nysg, nyng
1150	local_pf(i,j,nzb+1) = us_av(j,i)
1151	ENDDO
1152	ENDDO
1153	ENDIF
1154	resorted = .TRUE.
1155	two_d = .TRUE.
1156	level_z(nzb+1) = zu(nzb+1)
1157
1158	CASE ( 'v_xy', 'v_xz', 'v_yz' )
1159	IF ( av == 0 ) THEN
1160	to_be_resorted => v
1161	ELSE
1162	to_be_resorted => v_av
1163	ENDIF
1164	IF ( mode == 'xy' ) level_z = zu
1165	!
1166	!-- Substitute the values generated by "mirror" boundary condition
1167	!-- at the bottom boundary by the real surface values.
1168	IF ( do2d(av,if) == 'v_xz' .OR. do2d(av,if) == 'v_yz' ) THEN
1169	IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0_wp
1170	ENDIF
1171
1172	CASE ( 'vpt_xy', 'vpt_xz', 'vpt_yz' )
1173	IF ( av == 0 ) THEN
1174	to_be_resorted => vpt
1175	ELSE
1176	to_be_resorted => vpt_av
1177	ENDIF
1178	IF ( mode == 'xy' ) level_z = zu
1179
1180	CASE ( 'w_xy', 'w_xz', 'w_yz' )
1181	IF ( av == 0 ) THEN
1182	to_be_resorted => w
1183	ELSE
1184	to_be_resorted => w_av
1185	ENDIF
1186	IF ( mode == 'xy' ) level_z = zw
1187
1188	CASE ( 'z0*_xy' ) ! 2d-array
1189	IF ( av == 0 ) THEN
1190	DO i = nxlg, nxrg
1191	DO j = nysg, nyng
1192	local_pf(i,j,nzb+1) = z0(j,i)
1193	ENDDO
1194	ENDDO
1195	ELSE
1196	DO i = nxlg, nxrg
1197	DO j = nysg, nyng
1198	local_pf(i,j,nzb+1) = z0_av(j,i)
1199	ENDDO
1200	ENDDO
1201	ENDIF
1202	resorted = .TRUE.
1203	two_d = .TRUE.
1204	level_z(nzb+1) = zu(nzb+1)
1205
1206	CASE ( 'z0h*_xy' ) ! 2d-array
1207	IF ( av == 0 ) THEN
1208	DO i = nxlg, nxrg
1209	DO j = nysg, nyng
1210	local_pf(i,j,nzb+1) = z0h(j,i)
1211	ENDDO
1212	ENDDO
1213	ELSE
1214	DO i = nxlg, nxrg
1215	DO j = nysg, nyng
1216	local_pf(i,j,nzb+1) = z0h_av(j,i)
1217	ENDDO
1218	ENDDO
1219	ENDIF
1220	resorted = .TRUE.
1221	two_d = .TRUE.
1222	level_z(nzb+1) = zu(nzb+1)
1223
1224	CASE DEFAULT
1225	!
1226	!-- User defined quantity
1227	CALL user_data_output_2d( av, do2d(av,if), found, grid, &
1228	local_pf, two_d, nzb_do, nzt_do )
1229	resorted = .TRUE.
1230
1231	IF ( grid == 'zu' ) THEN
1232	IF ( mode == 'xy' ) level_z = zu
1233	ELSEIF ( grid == 'zw' ) THEN
1234	IF ( mode == 'xy' ) level_z = zw
1235	ELSEIF ( grid == 'zu1' ) THEN
1236	IF ( mode == 'xy' ) level_z(nzb+1) = zu(nzb+1)
1237	ELSEIF ( grid == 'zs' ) THEN
1238	IF ( mode == 'xy' ) level_z = zs
1239	ENDIF
1240
1241	IF ( .NOT. found ) THEN
1242	message_string = 'no output provided for: ' // &
1243	TRIM( do2d(av,if) )
1244	CALL message( 'data_output_2d', 'PA0181', 0, 0, 0, 6, 0 )
1245	ENDIF
1246
1247	END SELECT
1248
1249	!
1250	!-- Resort the array to be output, if not done above
1251	IF ( .NOT. resorted ) THEN
1252	DO i = nxlg, nxrg
1253	DO j = nysg, nyng
1254	DO k = nzb_do, nzt_do
1255	local_pf(i,j,k) = to_be_resorted(k,j,i)
1256	ENDDO
1257	ENDDO
1258	ENDDO
1259	ENDIF
1260
1261	!
1262	!-- Output of the individual cross-sections, depending on the cross-
1263	!-- section mode chosen.
1264	is = 1
1265	loop1: DO WHILE ( section(is,s) /= -9999 .OR. two_d )
1266
1267	SELECT CASE ( mode )
1268
1269	CASE ( 'xy' )
1270	!
1271	!-- Determine the cross section index
1272	IF ( two_d ) THEN
1273	layer_xy = nzb+1
1274	ELSE
1275	layer_xy = section(is,s)
1276	ENDIF
1277
1278	!
1279	!-- Exit the loop for layers beyond the data output domain
1280	!-- (used for soil model)
1281	IF ( layer_xy > nzt_do ) THEN
1282	EXIT loop1
1283	ENDIF
1284
1285	!
1286	!-- Update the netCDF xy cross section time axis.
1287	!-- In case of parallel output, this is only done by PE0
1288	!-- to increase the performance.
1289	IF ( simulated_time /= do2d_xy_last_time(av) ) THEN
1290	do2d_xy_time_count(av) = do2d_xy_time_count(av) + 1
1291	do2d_xy_last_time(av) = simulated_time
1292	IF ( myid == 0 ) THEN
1293	IF ( .NOT. data_output_2d_on_each_pe &
1294	.OR. netcdf_data_format > 4 ) &
1295	THEN
1296	#if defined( __netcdf )
1297	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1298	id_var_time_xy(av), &
1299	(/ time_since_reference_point /), &
1300	start = (/ do2d_xy_time_count(av) /), &
1301	count = (/ 1 /) )
1302	CALL handle_netcdf_error( 'data_output_2d', 53 )
1303	#endif
1304	ENDIF
1305	ENDIF
1306	ENDIF
1307	!
1308	!-- If required, carry out averaging along z
1309	IF ( section(is,s) == -1 .AND. .NOT. two_d ) THEN
1310
1311	local_2d = 0.0_wp
1312	!
1313	!-- Carry out the averaging (all data are on the PE)
1314	DO k = nzb_do, nzt_do
1315	DO j = nysg, nyng
1316	DO i = nxlg, nxrg
1317	local_2d(i,j) = local_2d(i,j) + local_pf(i,j,k)
1318	ENDDO
1319	ENDDO
1320	ENDDO
1321
1322	local_2d = local_2d / ( nzt_do - nzb_do + 1.0_wp)
1323
1324	ELSE
1325	!
1326	!-- Just store the respective section on the local array
1327	local_2d = local_pf(:,:,layer_xy)
1328
1329	ENDIF
1330
1331	#if defined( __parallel )
1332	IF ( netcdf_data_format > 4 ) THEN
1333	!
1334	!-- Parallel output in netCDF4/HDF5 format.
1335	IF ( two_d ) THEN
1336	iis = 1
1337	ELSE
1338	iis = is
1339	ENDIF
1340
1341	#if defined( __netcdf )
1342	!
1343	!-- For parallel output, all cross sections are first stored
1344	!-- here on a local array and will be written to the output
1345	!-- file afterwards to increase the performance.
1346	DO i = nxlg, nxrg
1347	DO j = nysg, nyng
1348	local_2d_sections(i,j,iis) = local_2d(i,j)
1349	ENDDO
1350	ENDDO
1351	#endif
1352	ELSE
1353
1354	IF ( data_output_2d_on_each_pe ) THEN
1355	!
1356	!-- Output of partial arrays on each PE
1357	#if defined( __netcdf )
1358	IF ( myid == 0 ) THEN
1359	WRITE ( 21 ) time_since_reference_point, &
1360	do2d_xy_time_count(av), av
1361	ENDIF
1362	#endif
1363	DO i = 0, io_blocks-1
1364	IF ( i == io_group ) THEN
1365	WRITE ( 21 ) nxlg, nxrg, nysg, nyng, nysg, nyng
1366	WRITE ( 21 ) local_2d
1367	ENDIF
1368	#if defined( __parallel )
1369	CALL MPI_BARRIER( comm2d, ierr )
1370	#endif
1371	ENDDO
1372
1373	ELSE
1374	!
1375	!-- PE0 receives partial arrays from all processors and
1376	!-- then outputs them. Here a barrier has to be set,
1377	!-- because otherwise "-MPI- FATAL: Remote protocol queue
1378	!-- full" may occur.
1379	CALL MPI_BARRIER( comm2d, ierr )
1380
1381	ngp = ( nxrg-nxlg+1 ) * ( nyng-nysg+1 )
1382	IF ( myid == 0 ) THEN
1383	!
1384	!-- Local array can be relocated directly.
1385	total_2d(nxlg:nxrg,nysg:nyng) = local_2d
1386	!
1387	!-- Receive data from all other PEs.
1388	DO n = 1, numprocs-1
1389	!
1390	!-- Receive index limits first, then array.
1391	!-- Index limits are received in arbitrary order from
1392	!-- the PEs.
1393	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
1394	MPI_ANY_SOURCE, 0, comm2d, &
1395	status, ierr )
1396	sender = status(MPI_SOURCE)
1397	DEALLOCATE( local_2d )
1398	ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
1399	CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
1400	MPI_REAL, sender, 1, comm2d, &
1401	status, ierr )
1402	total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
1403	ENDDO
1404	!
1405	!-- Relocate the local array for the next loop increment
1406	DEALLOCATE( local_2d )
1407	ALLOCATE( local_2d(nxlg:nxrg,nysg:nyng) )
1408
1409	#if defined( __netcdf )
1410	IF ( two_d ) THEN
1411	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1412	id_var_do2d(av,if), &
1413	total_2d(0:nx+1,0:ny+1), &
1414	start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
1415	count = (/ nx+2, ny+2, 1, 1 /) )
1416	ELSE
1417	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1418	id_var_do2d(av,if), &
1419	total_2d(0:nx+1,0:ny+1), &
1420	start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
1421	count = (/ nx+2, ny+2, 1, 1 /) )
1422	ENDIF
1423	CALL handle_netcdf_error( 'data_output_2d', 54 )
1424	#endif
1425
1426	ELSE
1427	!
1428	!-- First send the local index limits to PE0
1429	ind(1) = nxlg; ind(2) = nxrg
1430	ind(3) = nysg; ind(4) = nyng
1431	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
1432	comm2d, ierr )
1433	!
1434	!-- Send data to PE0
1435	CALL MPI_SEND( local_2d(nxlg,nysg), ngp, &
1436	MPI_REAL, 0, 1, comm2d, ierr )
1437	ENDIF
1438	!
1439	!-- A barrier has to be set, because otherwise some PEs may
1440	!-- proceed too fast so that PE0 may receive wrong data on
1441	!-- tag 0
1442	CALL MPI_BARRIER( comm2d, ierr )
1443	ENDIF
1444
1445	ENDIF
1446	#else
1447	#if defined( __netcdf )
1448	IF ( two_d ) THEN
1449	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1450	id_var_do2d(av,if), &
1451	local_2d(nxl:nxr+1,nys:nyn+1), &
1452	start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
1453	count = (/ nx+2, ny+2, 1, 1 /) )
1454	ELSE
1455	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1456	id_var_do2d(av,if), &
1457	local_2d(nxl:nxr+1,nys:nyn+1), &
1458	start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
1459	count = (/ nx+2, ny+2, 1, 1 /) )
1460	ENDIF
1461	CALL handle_netcdf_error( 'data_output_2d', 447 )
1462	#endif
1463	#endif
1464	do2d_xy_n = do2d_xy_n + 1
1465	!
1466	!-- For 2D-arrays (e.g. u*) only one cross-section is available.
1467	!-- Hence exit loop of output levels.
1468	IF ( two_d ) THEN
1469	two_d = .FALSE.
1470	EXIT loop1
1471	ENDIF
1472
1473	CASE ( 'xz' )
1474	!
1475	!-- Update the netCDF xz cross section time axis.
1476	!-- In case of parallel output, this is only done by PE0
1477	!-- to increase the performance.
1478	IF ( simulated_time /= do2d_xz_last_time(av) ) THEN
1479	do2d_xz_time_count(av) = do2d_xz_time_count(av) + 1
1480	do2d_xz_last_time(av) = simulated_time
1481	IF ( myid == 0 ) THEN
1482	IF ( .NOT. data_output_2d_on_each_pe &
1483	.OR. netcdf_data_format > 4 ) &
1484	THEN
1485	#if defined( __netcdf )
1486	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
1487	id_var_time_xz(av), &
1488	(/ time_since_reference_point /), &
1489	start = (/ do2d_xz_time_count(av) /), &
1490	count = (/ 1 /) )
1491	CALL handle_netcdf_error( 'data_output_2d', 56 )
1492	#endif
1493	ENDIF
1494	ENDIF
1495	ENDIF
1496
1497	!
1498	!-- If required, carry out averaging along y
1499	IF ( section(is,s) == -1 ) THEN
1500
1501	ALLOCATE( local_2d_l(nxlg:nxrg,nzb_do:nzt_do) )
1502	local_2d_l = 0.0_wp
1503	ngp = ( nxrg-nxlg + 1 ) * ( nzt_do-nzb_do + 1 )
1504	!
1505	!-- First local averaging on the PE
1506	DO k = nzb_do, nzt_do
1507	DO j = nys, nyn
1508	DO i = nxlg, nxrg
1509	local_2d_l(i,k) = local_2d_l(i,k) + &
1510	local_pf(i,j,k)
1511	ENDDO
1512	ENDDO
1513	ENDDO
1514	#if defined( __parallel )
1515	!
1516	!-- Now do the averaging over all PEs along y
1517	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
1518	CALL MPI_ALLREDUCE( local_2d_l(nxlg,nzb_do), &
1519	local_2d(nxlg,nzb_do), ngp, MPI_REAL, &
1520	MPI_SUM, comm1dy, ierr )
1521	#else
1522	local_2d = local_2d_l
1523	#endif
1524	local_2d = local_2d / ( ny + 1.0_wp )
1525
1526	DEALLOCATE( local_2d_l )
1527
1528	ELSE
1529	!
1530	!-- Just store the respective section on the local array
1531	!-- (but only if it is available on this PE!)
1532	IF ( section(is,s) >= nys .AND. section(is,s) <= nyn ) &
1533	THEN
1534	local_2d = local_pf(:,section(is,s),nzb_do:nzt_do)
1535	ENDIF
1536
1537	ENDIF
1538
1539	#if defined( __parallel )
1540	IF ( netcdf_data_format > 4 ) THEN
1541	!
1542	!-- Output in netCDF4/HDF5 format.
1543	!-- Output only on those PEs where the respective cross
1544	!-- sections reside. Cross sections averaged along y are
1545	!-- output on the respective first PE along y (myidy=0).
1546	IF ( ( section(is,s) >= nys .AND. &
1547	section(is,s) <= nyn ) .OR. &
1548	( section(is,s) == -1 .AND. myidy == 0 ) ) THEN
1549	#if defined( __netcdf )
1550	!
1551	!-- For parallel output, all cross sections are first
1552	!-- stored here on a local array and will be written to the
1553	!-- output file afterwards to increase the performance.
1554	DO i = nxlg, nxrg
1555	DO k = nzb_do, nzt_do
1556	local_2d_sections_l(i,is,k) = local_2d(i,k)
1557	ENDDO
1558	ENDDO
1559	#endif
1560	ENDIF
1561
1562	ELSE
1563
1564	IF ( data_output_2d_on_each_pe ) THEN
1565	!
1566	!-- Output of partial arrays on each PE. If the cross
1567	!-- section does not reside on the PE, output special
1568	!-- index values.
1569	#if defined( __netcdf )
1570	IF ( myid == 0 ) THEN
1571	WRITE ( 22 ) time_since_reference_point, &
1572	do2d_xz_time_count(av), av
1573	ENDIF
1574	#endif
1575	DO i = 0, io_blocks-1
1576	IF ( i == io_group ) THEN
1577	IF ( ( section(is,s) >= nys .AND. &
1578	section(is,s) <= nyn ) .OR. &
1579	( section(is,s) == -1 .AND. &
1580	nys-1 == -1 ) ) &
1581	THEN
1582	WRITE (22) nxlg, nxrg, nzb_do, nzt_do, nzb, nzt+1
1583	WRITE (22) local_2d
1584	ELSE
1585	WRITE (22) -1, -1, -1, -1, -1, -1
1586	ENDIF
1587	ENDIF
1588	#if defined( __parallel )
1589	CALL MPI_BARRIER( comm2d, ierr )
1590	#endif
1591	ENDDO
1592
1593	ELSE
1594	!
1595	!-- PE0 receives partial arrays from all processors of the
1596	!-- respective cross section and outputs them. Here a
1597	!-- barrier has to be set, because otherwise
1598	!-- "-MPI- FATAL: Remote protocol queue full" may occur.
1599	CALL MPI_BARRIER( comm2d, ierr )
1600
1601	ngp = ( nxrg-nxlg + 1 ) * ( nzt_do-nzb_do + 1 )
1602	IF ( myid == 0 ) THEN
1603	!
1604	!-- Local array can be relocated directly.
1605	IF ( ( section(is,s) >= nys .AND. &
1606	section(is,s) <= nyn ) .OR. &
1607	( section(is,s) == -1 .AND. nys-1 == -1 ) ) &
1608	THEN
1609	total_2d(nxlg:nxrg,nzb_do:nzt_do) = local_2d
1610	ENDIF
1611	!
1612	!-- Receive data from all other PEs.
1613	DO n = 1, numprocs-1
1614	!
1615	!-- Receive index limits first, then array.
1616	!-- Index limits are received in arbitrary order from
1617	!-- the PEs.
1618	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
1619	MPI_ANY_SOURCE, 0, comm2d, &
1620	status, ierr )
1621	!
1622	!-- Not all PEs have data for XZ-cross-section.
1623	IF ( ind(1) /= -9999 ) THEN
1624	sender = status(MPI_SOURCE)
1625	DEALLOCATE( local_2d )
1626	ALLOCATE( local_2d(ind(1):ind(2), &
1627	ind(3):ind(4)) )
1628	CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
1629	MPI_REAL, sender, 1, comm2d, &
1630	status, ierr )
1631	total_2d(ind(1):ind(2),ind(3):ind(4)) = &
1632	local_2d
1633	ENDIF
1634	ENDDO
1635	!
1636	!-- Relocate the local array for the next loop increment
1637	DEALLOCATE( local_2d )
1638	ALLOCATE( local_2d(nxlg:nxrg,nzb_do:nzt_do) )
1639
1640	#if defined( __netcdf )
1641	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
1642	id_var_do2d(av,if), &
1643	total_2d(0:nx+1,nzb_do:nzt_do),&
1644	start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
1645	count = (/ nx+2, 1, nzt_do-nzb_do+1, 1 /) )
1646	CALL handle_netcdf_error( 'data_output_2d', 58 )
1647	#endif
1648
1649	ELSE
1650	!
1651	!-- If the cross section resides on the PE, send the
1652	!-- local index limits, otherwise send -9999 to PE0.
1653	IF ( ( section(is,s) >= nys .AND. &
1654	section(is,s) <= nyn ) .OR. &
1655	( section(is,s) == -1 .AND. nys-1 == -1 ) ) &
1656	THEN
1657	ind(1) = nxlg; ind(2) = nxrg
1658	ind(3) = nzb_do; ind(4) = nzt_do
1659	ELSE
1660	ind(1) = -9999; ind(2) = -9999
1661	ind(3) = -9999; ind(4) = -9999
1662	ENDIF
1663	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
1664	comm2d, ierr )
1665	!
1666	!-- If applicable, send data to PE0.
1667	IF ( ind(1) /= -9999 ) THEN
1668	CALL MPI_SEND( local_2d(nxlg,nzb_do), ngp, &
1669	MPI_REAL, 0, 1, comm2d, ierr )
1670	ENDIF
1671	ENDIF
1672	!
1673	!-- A barrier has to be set, because otherwise some PEs may
1674	!-- proceed too fast so that PE0 may receive wrong data on
1675	!-- tag 0
1676	CALL MPI_BARRIER( comm2d, ierr )
1677	ENDIF
1678
1679	ENDIF
1680	#else
1681	#if defined( __netcdf )
1682	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
1683	id_var_do2d(av,if), &
1684	local_2d(nxl:nxr+1,nzb_do:nzt_do), &
1685	start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
1686	count = (/ nx+2, 1, nzt_do-nzb_do+1, 1 /) )
1687	CALL handle_netcdf_error( 'data_output_2d', 451 )
1688	#endif
1689	#endif
1690	do2d_xz_n = do2d_xz_n + 1
1691
1692	CASE ( 'yz' )
1693	!
1694	!-- Update the netCDF yz cross section time axis.
1695	!-- In case of parallel output, this is only done by PE0
1696	!-- to increase the performance.
1697	IF ( simulated_time /= do2d_yz_last_time(av) ) THEN
1698	do2d_yz_time_count(av) = do2d_yz_time_count(av) + 1
1699	do2d_yz_last_time(av) = simulated_time
1700	IF ( myid == 0 ) THEN
1701	IF ( .NOT. data_output_2d_on_each_pe &
1702	.OR. netcdf_data_format > 4 ) &
1703	THEN
1704	#if defined( __netcdf )
1705	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
1706	id_var_time_yz(av), &
1707	(/ time_since_reference_point /), &
1708	start = (/ do2d_yz_time_count(av) /), &
1709	count = (/ 1 /) )
1710	CALL handle_netcdf_error( 'data_output_2d', 59 )
1711	#endif
1712	ENDIF
1713	ENDIF
1714	ENDIF
1715
1716	!
1717	!-- If required, carry out averaging along x
1718	IF ( section(is,s) == -1 ) THEN
1719
1720	ALLOCATE( local_2d_l(nysg:nyng,nzb_do:nzt_do) )
1721	local_2d_l = 0.0_wp
1722	ngp = ( nyng-nysg+1 ) * ( nzt_do-nzb_do+1 )
1723	!
1724	!-- First local averaging on the PE
1725	DO k = nzb_do, nzt_do
1726	DO j = nysg, nyng
1727	DO i = nxl, nxr
1728	local_2d_l(j,k) = local_2d_l(j,k) + &
1729	local_pf(i,j,k)
1730	ENDDO
1731	ENDDO
1732	ENDDO
1733	#if defined( __parallel )
1734	!
1735	!-- Now do the averaging over all PEs along x
1736	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
1737	CALL MPI_ALLREDUCE( local_2d_l(nysg,nzb_do), &
1738	local_2d(nysg,nzb_do), ngp, MPI_REAL, &
1739	MPI_SUM, comm1dx, ierr )
1740	#else
1741	local_2d = local_2d_l
1742	#endif
1743	local_2d = local_2d / ( nx + 1.0_wp )
1744
1745	DEALLOCATE( local_2d_l )
1746
1747	ELSE
1748	!
1749	!-- Just store the respective section on the local array
1750	!-- (but only if it is available on this PE!)
1751	IF ( section(is,s) >= nxl .AND. section(is,s) <= nxr ) &
1752	THEN
1753	local_2d = local_pf(section(is,s),:,nzb_do:nzt_do)
1754	ENDIF
1755
1756	ENDIF
1757
1758	#if defined( __parallel )
1759	IF ( netcdf_data_format > 4 ) THEN
1760	!
1761	!-- Output in netCDF4/HDF5 format.
1762	!-- Output only on those PEs where the respective cross
1763	!-- sections reside. Cross sections averaged along x are
1764	!-- output on the respective first PE along x (myidx=0).
1765	IF ( ( section(is,s) >= nxl .AND. &
1766	section(is,s) <= nxr ) .OR. &
1767	( section(is,s) == -1 .AND. myidx == 0 ) ) THEN
1768	#if defined( __netcdf )
1769	!
1770	!-- For parallel output, all cross sections are first
1771	!-- stored here on a local array and will be written to the
1772	!-- output file afterwards to increase the performance.
1773	DO j = nysg, nyng
1774	DO k = nzb_do, nzt_do
1775	local_2d_sections_l(is,j,k) = local_2d(j,k)
1776	ENDDO
1777	ENDDO
1778	#endif
1779	ENDIF
1780
1781	ELSE
1782
1783	IF ( data_output_2d_on_each_pe ) THEN
1784	!
1785	!-- Output of partial arrays on each PE. If the cross
1786	!-- section does not reside on the PE, output special
1787	!-- index values.
1788	#if defined( __netcdf )
1789	IF ( myid == 0 ) THEN
1790	WRITE ( 23 ) time_since_reference_point, &
1791	do2d_yz_time_count(av), av
1792	ENDIF
1793	#endif
1794	DO i = 0, io_blocks-1
1795	IF ( i == io_group ) THEN
1796	IF ( ( section(is,s) >= nxl .AND. &
1797	section(is,s) <= nxr ) .OR. &
1798	( section(is,s) == -1 .AND. &
1799	nxl-1 == -1 ) ) &
1800	THEN
1801	WRITE (23) nysg, nyng, nzb_do, nzt_do, nzb, nzt+1
1802	WRITE (23) local_2d
1803	ELSE
1804	WRITE (23) -1, -1, -1, -1, -1, -1
1805	ENDIF
1806	ENDIF
1807	#if defined( __parallel )
1808	CALL MPI_BARRIER( comm2d, ierr )
1809	#endif
1810	ENDDO
1811
1812	ELSE
1813	!
1814	!-- PE0 receives partial arrays from all processors of the
1815	!-- respective cross section and outputs them. Here a
1816	!-- barrier has to be set, because otherwise
1817	!-- "-MPI- FATAL: Remote protocol queue full" may occur.
1818	CALL MPI_BARRIER( comm2d, ierr )
1819
1820	ngp = ( nyng-nysg+1 ) * ( nzt_do-nzb_do+1 )
1821	IF ( myid == 0 ) THEN
1822	!
1823	!-- Local array can be relocated directly.
1824	IF ( ( section(is,s) >= nxl .AND. &
1825	section(is,s) <= nxr ) .OR. &
1826	( section(is,s) == -1 .AND. nxl-1 == -1 ) ) &
1827	THEN
1828	total_2d(nysg:nyng,nzb_do:nzt_do) = local_2d
1829	ENDIF
1830	!
1831	!-- Receive data from all other PEs.
1832	DO n = 1, numprocs-1
1833	!
1834	!-- Receive index limits first, then array.
1835	!-- Index limits are received in arbitrary order from
1836	!-- the PEs.
1837	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
1838	MPI_ANY_SOURCE, 0, comm2d, &
1839	status, ierr )
1840	!
1841	!-- Not all PEs have data for YZ-cross-section.
1842	IF ( ind(1) /= -9999 ) THEN
1843	sender = status(MPI_SOURCE)
1844	DEALLOCATE( local_2d )
1845	ALLOCATE( local_2d(ind(1):ind(2), &
1846	ind(3):ind(4)) )
1847	CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
1848	MPI_REAL, sender, 1, comm2d, &
1849	status, ierr )
1850	total_2d(ind(1):ind(2),ind(3):ind(4)) = &
1851	local_2d
1852	ENDIF
1853	ENDDO
1854	!
1855	!-- Relocate the local array for the next loop increment
1856	DEALLOCATE( local_2d )
1857	ALLOCATE( local_2d(nysg:nyng,nzb_do:nzt_do) )
1858
1859	#if defined( __netcdf )
1860	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
1861	id_var_do2d(av,if), &
1862	total_2d(0:ny+1,nzb_do:nzt_do),&
1863	start = (/ is, 1, 1, do2d_yz_time_count(av) /), &
1864	count = (/ 1, ny+2, nzt_do-nzb_do+1, 1 /) )
1865	CALL handle_netcdf_error( 'data_output_2d', 61 )
1866	#endif
1867
1868	ELSE
1869	!
1870	!-- If the cross section resides on the PE, send the
1871	!-- local index limits, otherwise send -9999 to PE0.
1872	IF ( ( section(is,s) >= nxl .AND. &
1873	section(is,s) <= nxr ) .OR. &
1874	( section(is,s) == -1 .AND. nxl-1 == -1 ) ) &
1875	THEN
1876	ind(1) = nysg; ind(2) = nyng
1877	ind(3) = nzb_do; ind(4) = nzt_do
1878	ELSE
1879	ind(1) = -9999; ind(2) = -9999
1880	ind(3) = -9999; ind(4) = -9999
1881	ENDIF
1882	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
1883	comm2d, ierr )
1884	!
1885	!-- If applicable, send data to PE0.
1886	IF ( ind(1) /= -9999 ) THEN
1887	CALL MPI_SEND( local_2d(nysg,nzb_do), ngp, &
1888	MPI_REAL, 0, 1, comm2d, ierr )
1889	ENDIF
1890	ENDIF
1891	!
1892	!-- A barrier has to be set, because otherwise some PEs may
1893	!-- proceed too fast so that PE0 may receive wrong data on
1894	!-- tag 0
1895	CALL MPI_BARRIER( comm2d, ierr )
1896	ENDIF
1897
1898	ENDIF
1899	#else
1900	#if defined( __netcdf )
1901	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
1902	id_var_do2d(av,if), &
1903	local_2d(nys:nyn+1,nzb_do:nzt_do), &
1904	start = (/ is, 1, 1, do2d_xz_time_count(av) /), &
1905	count = (/ 1, ny+2, nzt_do-nzb_do+1, 1 /) )
1906	CALL handle_netcdf_error( 'data_output_2d', 452 )
1907	#endif
1908	#endif
1909	do2d_yz_n = do2d_yz_n + 1
1910
1911	END SELECT
1912
1913	is = is + 1
1914	ENDDO loop1
1915
1916	!
1917	!-- For parallel output, all data were collected before on a local array
1918	!-- and are written now to the netcdf file. This must be done to increase
1919	!-- the performance of the parallel output.
1920	#if defined( __netcdf )
1921	IF ( netcdf_data_format > 4 ) THEN
1922
1923	SELECT CASE ( mode )
1924
1925	CASE ( 'xy' )
1926	IF ( two_d ) THEN
1927	iis = 1
1928	ELSE
1929	iis = is-1
1930	ENDIF
1931	!
1932	!-- Do not output redundant ghost point data except for the
1933	!-- boundaries of the total domain.
1934	IF ( nxr == nx .AND. nyn /= ny ) THEN
1935	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1936	id_var_do2d(av,if), &
1937	local_2d_sections(nxl:nxr+1, &
1938	nys:nyn,1:ns), &
1939	start = (/ nxl+1, nys+1, 1, &
1940	do2d_xy_time_count(av) /), &
1941	count = (/ nxr-nxl+2, &
1942	nyn-nys+1, ns, 1 &
1943	/) )
1944	ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN
1945	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1946	id_var_do2d(av,if), &
1947	local_2d_sections(nxl:nxr, &
1948	nys:nyn+1,1:ns), &
1949	start = (/ nxl+1, nys+1, 1, &
1950	do2d_xy_time_count(av) /), &
1951	count = (/ nxr-nxl+1, &
1952	nyn-nys+2, ns, 1 &
1953	/) )
1954	ELSEIF ( nxr == nx .AND. nyn == ny ) THEN
1955	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1956	id_var_do2d(av,if), &
1957	local_2d_sections(nxl:nxr+1, &
1958	nys:nyn+1,1:ns), &
1959	start = (/ nxl+1, nys+1, 1, &
1960	do2d_xy_time_count(av) /), &
1961	count = (/ nxr-nxl+2, &
1962	nyn-nys+2, ns, 1 &
1963	/) )
1964	ELSE
1965	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1966	id_var_do2d(av,if), &
1967	local_2d_sections(nxl:nxr, &
1968	nys:nyn,1:ns), &
1969	start = (/ nxl+1, nys+1, 1, &
1970	do2d_xy_time_count(av) /), &
1971	count = (/ nxr-nxl+1, &
1972	nyn-nys+1, ns, 1 &
1973	/) )
1974	ENDIF
1975
1976	CALL handle_netcdf_error( 'data_output_2d', 55 )
1977
1978	CASE ( 'xz' )
1979	!
1980	!-- First, all PEs get the information of all cross-sections.
1981	!-- Then the data are written to the output file by all PEs
1982	!-- while NF90_COLLECTIVE is set in subroutine
1983	!-- define_netcdf_header. Although redundant information are
1984	!-- written to the output file in that case, the performance
1985	!-- is significantly better compared to the case where only
1986	!-- the first row of PEs in x-direction (myidx = 0) is given
1987	!-- the output while NF90_INDEPENDENT is set.
1988	IF ( npey /= 1 ) THEN
1989
1990	#if defined( __parallel )
1991	!
1992	!-- Distribute data over all PEs along y
1993	ngp = ( nxrg-nxlg+1 ) * ( nzt_do-nzb_do+1 ) * ns
1994	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
1995	CALL MPI_ALLREDUCE( local_2d_sections_l(nxlg,1,nzb_do), &
1996	local_2d_sections(nxlg,1,nzb_do), &
1997	ngp, MPI_REAL, MPI_SUM, comm1dy, &
1998	ierr )
1999	#else
2000	local_2d_sections = local_2d_sections_l
2001	#endif
2002	ENDIF
2003	!
2004	!-- Do not output redundant ghost point data except for the
2005	!-- boundaries of the total domain.
2006	IF ( nxr == nx ) THEN
2007	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
2008	id_var_do2d(av,if), &
2009	local_2d_sections(nxl:nxr+1,1:ns, &
2010	nzb_do:nzt_do), &
2011	start = (/ nxl+1, 1, 1, &
2012	do2d_xz_time_count(av) /), &
2013	count = (/ nxr-nxl+2, ns, nzt_do-nzb_do+1, &
2014	1 /) )
2015	ELSE
2016	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
2017	id_var_do2d(av,if), &
2018	local_2d_sections(nxl:nxr,1:ns, &
2019	nzb_do:nzt_do), &
2020	start = (/ nxl+1, 1, 1, &
2021	do2d_xz_time_count(av) /), &
2022	count = (/ nxr-nxl+1, ns, nzt_do-nzb_do+1, &
2023	1 /) )
2024	ENDIF
2025
2026	CALL handle_netcdf_error( 'data_output_2d', 57 )
2027
2028	CASE ( 'yz' )
2029	!
2030	!-- First, all PEs get the information of all cross-sections.
2031	!-- Then the data are written to the output file by all PEs
2032	!-- while NF90_COLLECTIVE is set in subroutine
2033	!-- define_netcdf_header. Although redundant information are
2034	!-- written to the output file in that case, the performance
2035	!-- is significantly better compared to the case where only
2036	!-- the first row of PEs in y-direction (myidy = 0) is given
2037	!-- the output while NF90_INDEPENDENT is set.
2038	IF ( npex /= 1 ) THEN
2039
2040	#if defined( __parallel )
2041	!
2042	!-- Distribute data over all PEs along x
2043	ngp = ( nyng-nysg+1 ) * ( nzt-nzb + 2 ) * ns
2044	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
2045	CALL MPI_ALLREDUCE( local_2d_sections_l(1,nysg,nzb_do), &
2046	local_2d_sections(1,nysg,nzb_do), &
2047	ngp, MPI_REAL, MPI_SUM, comm1dx, &
2048	ierr )
2049	#else
2050	local_2d_sections = local_2d_sections_l
2051	#endif
2052	ENDIF
2053	!
2054	!-- Do not output redundant ghost point data except for the
2055	!-- boundaries of the total domain.
2056	IF ( nyn == ny ) THEN
2057	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
2058	id_var_do2d(av,if), &
2059	local_2d_sections(1:ns, &
2060	nys:nyn+1,nzb_do:nzt_do), &
2061	start = (/ 1, nys+1, 1, &
2062	do2d_yz_time_count(av) /), &
2063	count = (/ ns, nyn-nys+2, &
2064	nzt_do-nzb_do+1, 1 /) )
2065	ELSE
2066	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
2067	id_var_do2d(av,if), &
2068	local_2d_sections(1:ns,nys:nyn, &
2069	nzb_do:nzt_do), &
2070	start = (/ 1, nys+1, 1, &
2071	do2d_yz_time_count(av) /), &
2072	count = (/ ns, nyn-nys+1, &
2073	nzt_do-nzb_do+1, 1 /) )
2074	ENDIF
2075
2076	CALL handle_netcdf_error( 'data_output_2d', 60 )
2077
2078	CASE DEFAULT
2079	message_string = 'unknown cross-section: ' // TRIM( mode )
2080	CALL message( 'data_output_2d', 'PA0180', 1, 2, 0, 6, 0 )
2081
2082	END SELECT
2083
2084	ENDIF
2085	#endif
2086	ENDIF
2087
2088	if = if + 1
2089	l = MAX( 2, LEN_TRIM( do2d(av,if) ) )
2090	do2d_mode = do2d(av,if)(l-1:l)
2091
2092	ENDDO
2093
2094	!
2095	!-- Deallocate temporary arrays.
2096	IF ( ALLOCATED( level_z ) ) DEALLOCATE( level_z )
2097	IF ( netcdf_data_format > 4 ) THEN
2098	DEALLOCATE( local_pf, local_2d, local_2d_sections )
2099	IF( mode == 'xz' .OR. mode == 'yz' ) DEALLOCATE( local_2d_sections_l )
2100	ENDIF
2101	#if defined( __parallel )
2102	IF ( .NOT. data_output_2d_on_each_pe .AND. myid == 0 ) THEN
2103	DEALLOCATE( total_2d )
2104	ENDIF
2105	#endif
2106
2107	!
2108	!-- Close plot output file.
2109	file_id = 20 + s
2110
2111	IF ( data_output_2d_on_each_pe ) THEN
2112	DO i = 0, io_blocks-1
2113	IF ( i == io_group ) THEN
2114	CALL close_file( file_id )
2115	ENDIF
2116	#if defined( __parallel )
2117	CALL MPI_BARRIER( comm2d, ierr )
2118	#endif
2119	ENDDO
2120	ELSE
2121	IF ( myid == 0 ) CALL close_file( file_id )
2122	ENDIF
2123
2124	CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
2125
2126	END SUBROUTINE data_output_2d

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |