Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |