Home

Context Navigation

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

Last change on this file since 2709 was 2696, checked in by kanani, 7 years ago
Merge of branch palm4u into trunk
Property svn:keywords set to `Id`
File size: 84.2 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |