Home

Context Navigation

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

Last change on this file since 1585 was 1585, checked in by maronga, 9 years ago
Added support for RRTMG radiation code
Property svn:keywords set to `Id`
File size: 84.4 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |