Home

Context Navigation

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

Last change on this file since 1960 was 1960, checked in by suehring, 8 years ago
Separate balance equations for humidity and passive_scalar
Property svn:keywords set to `Id`
File size: 88.7 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |