Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |