Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |