Home

Context Navigation

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

Last change on this file since 1780 was 1746, checked in by gronemeier, 9 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 87.4 KB

Rev	Line
[1682]	1	!> @file data_output_2d.f90
[1036]	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	!
[1691]	16	! Copyright 1997-2015 Leibniz Universitaet Hannover
[1704]	17	!--------------------------------------------------------------------------------!
[1036]	18	!
[254]	19	! Current revisions:
[1]	20	! -----------------
[1746]	21	!
	22	!
[1552]	23	! Former revisions:
	24	! -----------------
	25	! $Id: data_output_2d.f90 1746 2016-02-05 13:19:50Z raasch $
	26	!
[1746]	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	!
[1704]	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	!
[1702]	33	! 1701 2015-11-02 07:43:04Z maronga
	34	! Bugfix in output of RRTGM data
	35	!
[1692]	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	!
[1683]	40	! 1682 2015-10-07 23:56:08Z knoop
	41	! Code annotations made doxygen readable
	42	!
[1586]	43	! 1585 2015-04-30 07:05:52Z maronga
	44	! Added support for RRTMG
	45	!
[1556]	46	! 1555 2015-03-04 17:44:27Z maronga
	47	! Added output of r_a and r_s
	48	!
[1552]	49	! 1551 2015-03-03 14:18:16Z maronga
[1551]	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.
[1329]	54	!
[1360]	55	! 1359 2014-04-11 17:15:14Z hoffmann
	56	! New particle structure integrated.
	57	!
[1354]	58	! 1353 2014-04-08 15:21:23Z heinze
	59	! REAL constants provided with KIND-attribute
	60	!
[1329]	61	! 1327 2014-03-21 11:00:16Z raasch
	62	! parts concerning iso2d output removed,
	63	! -netcdf output queries
	64	!
[1321]	65	! 1320 2014-03-20 08:40:49Z raasch
[1320]	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
[1309]	72	!
[1319]	73	! 1318 2014-03-17 13:35:16Z raasch
	74	! barrier argument removed from cpu_log.
	75	! module interfaces removed
	76	!
[1312]	77	! 1311 2014-03-14 12:13:39Z heinze
	78	! bugfix: close #if defined( __netcdf )
	79	!
[1309]	80	! 1308 2014-03-13 14:58:42Z fricke
[1308]	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.
[674]	87	!
[1116]	88	! 1115 2013-03-26 18:16:16Z hoffmann
	89	! ql is calculated by calc_liquid_water_content
	90	!
[1077]	91	! 1076 2012-12-05 08:30:18Z hoffmann
	92	! Bugfix in output of ql
	93	!
[1066]	94	! 1065 2012-11-22 17:42:36Z hoffmann
	95	! Bugfix: Output of cross sections of ql
	96	!
[1054]	97	! 1053 2012-11-13 17:11:03Z hoffmann
	98	! +qr, nr, qc and cross sections
	99	!
[1037]	100	! 1036 2012-10-22 13:43:42Z raasch
	101	! code put under GPL (PALM 3.9)
	102	!
[1035]	103	! 1031 2012-10-19 14:35:30Z raasch
	104	! netCDF4 without parallel file support implemented
	105	!
[1008]	106	! 1007 2012-09-19 14:30:36Z franke
	107	! Bugfix: missing calculation of ql_vp added
	108	!
[979]	109	! 978 2012-08-09 08:28:32Z fricke
	110	! +z0h
	111	!
[1]	112	! Revision 1.1 1997/08/11 06:24:09 raasch
	113	! Initial revision
	114	!
	115	!
	116	! Description:
	117	! ------------
[1682]	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)!
[1]	122	!------------------------------------------------------------------------------!
[1682]	123	SUBROUTINE data_output_2d( mode, av )
	124
[1]	125
[1320]	126	USE arrays_3d, &
[1691]	127	ONLY: dzw, e, nr, ol, p, pt, q, qc, ql, ql_c, ql_v, ql_vp, qr, qsws, &
[1320]	128	rho, sa, shf, tend, ts, u, us, v, vpt, w, z0, z0h, zu, zw
	129
[1]	130	USE averaging
[1320]	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, &
[1327]	142	ibc_uv_b, icloud_scheme, io_blocks, io_group, &
	143	message_string, netcdf_data_format, &
[1320]	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
[1551]	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, &
[1555]	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
[1551]	166
[1]	167	USE netcdf_control
[1320]	168
	169	USE particle_attributes, &
[1359]	170	ONLY: grid_particles, number_of_particles, particle_advection_start, &
	171	particles, prt_count
[1320]	172
[1]	173	USE pegrid
	174
[1551]	175	USE radiation_model_mod, &
[1585]	176	ONLY: rad_net, rad_net_av, rad_sw_in, rad_sw_in_av, rad_sw_out, &
[1691]	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
[1551]	181
[1]	182	IMPLICIT NONE
	183
[1682]	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 !<
[1320]	189
[1682]	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 !<
[1703]	202	INTEGER(iwp) :: nis !<
[1682]	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) !<
[1320]	210
[1682]	211	LOGICAL :: found !<
	212	LOGICAL :: resorted !<
	213	LOGICAL :: two_d !<
[1320]	214
[1682]	215	REAL(wp) :: mean_r !<
	216	REAL(wp) :: s_r2 !<
	217	REAL(wp) :: s_r3 !<
[1320]	218
[1682]	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 !<
[1359]	225
[1]	226	#if defined( __parallel )
[1682]	227	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: total_2d !<
[1]	228	#endif
[1682]	229	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !<
[1]	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
[1308]	240	CALL cpu_log (log_point(3),'data_output_2d','start')
	241
[1]	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
[667]	252	ALLOCATE( level_z(nzb:nzt+1), local_2d(nxlg:nxrg,nysg:nyng) )
[1]	253
[1308]	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) )
[1353]	261	local_2d_sections = 0.0_wp
[1308]	262	ENDIF
	263
[493]	264	!
[1031]	265	!-- Parallel netCDF4/HDF5 output is done on all PEs, all other on PE0 only
[1327]	266	IF ( myid == 0 .OR. netcdf_data_format > 4 ) THEN
[493]	267	CALL check_open( 101+av*10 )
	268	ENDIF
[1]	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 )
[667]	275	ALLOCATE( total_2d(-nbgp:nx+nbgp,-nbgp:ny+nbgp) )
[1]	276	#endif
	277	ENDIF
	278	ENDIF
	279
	280	CASE ( 'xz' )
	281	s = 2
[667]	282	ALLOCATE( local_2d(nxlg:nxrg,nzb:nzt+1) )
[1]	283
[1308]	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) )
[1353]	292	local_2d_sections = 0.0_wp; local_2d_sections_l = 0.0_wp
[1308]	293	ENDIF
	294
[493]	295	!
[1031]	296	!-- Parallel netCDF4/HDF5 output is done on all PEs, all other on PE0 only
[1327]	297	IF ( myid == 0 .OR. netcdf_data_format > 4 ) THEN
[493]	298	CALL check_open( 102+av*10 )
	299	ENDIF
[1]	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 )
[667]	306	ALLOCATE( total_2d(-nbgp:nx+nbgp,nzb:nzt+1) )
[1]	307	#endif
	308	ENDIF
	309	ENDIF
	310
	311	CASE ( 'yz' )
	312	s = 3
[667]	313	ALLOCATE( local_2d(nysg:nyng,nzb:nzt+1) )
[1]	314
[1308]	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) )
[1353]	323	local_2d_sections = 0.0_wp; local_2d_sections_l = 0.0_wp
[1308]	324	ENDIF
	325
[493]	326	!
[1031]	327	!-- Parallel netCDF4/HDF5 output is done on all PEs, all other on PE0 only
[1327]	328	IF ( myid == 0 .OR. netcdf_data_format > 4 ) THEN
[493]	329	CALL check_open( 103+av*10 )
	330	ENDIF
[1]	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 )
[667]	337	ALLOCATE( total_2d(-nbgp:ny+nbgp,nzb:nzt+1) )
[1]	338	#endif
	339	ENDIF
	340	ENDIF
	341
	342	CASE DEFAULT
[254]	343	message_string = 'unknown cross-section: ' // TRIM( mode )
	344	CALL message( 'data_output_2d', 'PA0180', 1, 2, 0, 6, 0 )
[1]	345
	346	END SELECT
	347
	348	!
[1745]	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	!
[1]	383	!-- Allocate a temporary array for resorting (kji -> ijk).
[667]	384	ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb:nzt+1) )
[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
[1551]	396
	397	nzb_do = nzb
	398	nzt_do = nzt+1
[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
[1551]	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
[771]	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
[1]	510	CASE ( 'lwp*_xy' ) ! 2d-array
	511	IF ( av == 0 ) THEN
[667]	512	DO i = nxlg, nxrg
	513	DO j = nysg, nyng
[1320]	514	local_pf(i,j,nzb+1) = SUM( ql(nzb:nzt,j,i) * &
[1]	515	dzw(1:nzt+1) )
	516	ENDDO
	517	ENDDO
	518	ELSE
[667]	519	DO i = nxlg, nxrg
	520	DO j = nysg, nyng
[1]	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
[1551]	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
[1053]	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
[1691]	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
[1]	583	CASE ( 'p_xy', 'p_xz', 'p_yz' )
	584	IF ( av == 0 ) THEN
[729]	585	IF ( psolver /= 'sor' ) CALL exchange_horiz( p, nbgp )
[1]	586	to_be_resorted => p
	587	ELSE
[729]	588	IF ( psolver /= 'sor' ) CALL exchange_horiz( p_av, nbgp )
[1]	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
[215]	595	IF ( simulated_time >= particle_advection_start ) THEN
	596	tend = prt_count
[667]	597	CALL exchange_horiz( tend, nbgp )
[215]	598	ELSE
[1353]	599	tend = 0.0_wp
[215]	600	ENDIF
[667]	601	DO i = nxlg, nxrg
	602	DO j = nysg, nyng
[1]	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
[667]	610	CALL exchange_horiz( pc_av, nbgp )
[1]	611	to_be_resorted => pc_av
	612	ENDIF
	613
[1359]	614	CASE ( 'pr_xy', 'pr_xz', 'pr_yz' ) ! mean particle radius (effective radius)
[1]	615	IF ( av == 0 ) THEN
[215]	616	IF ( simulated_time >= particle_advection_start ) THEN
	617	DO i = nxl, nxr
	618	DO j = nys, nyn
	619	DO k = nzb, nzt+1
[1359]	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
[1353]	624	s_r3 = 0.0_wp
[1359]	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
[215]	632	ENDDO
[1359]	633	IF ( s_r2 > 0.0_wp ) THEN
	634	mean_r = s_r3 / s_r2
[215]	635	ELSE
[1353]	636	mean_r = 0.0_wp
[215]	637	ENDIF
	638	tend(k,j,i) = mean_r
[1]	639	ENDDO
	640	ENDDO
	641	ENDDO
[667]	642	CALL exchange_horiz( tend, nbgp )
[215]	643	ELSE
[1353]	644	tend = 0.0_wp
[1359]	645	ENDIF
[667]	646	DO i = nxlg, nxrg
	647	DO j = nysg, nyng
[1]	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
[667]	655	CALL exchange_horiz( pr_av, nbgp )
[1]	656	to_be_resorted => pr_av
	657	ENDIF
	658
[72]	659	CASE ( 'pra*_xy' ) ! 2d-array / integral quantity => no av
	660	CALL exchange_horiz_2d( precipitation_amount )
[667]	661	DO i = nxlg, nxrg
	662	DO j = nysg, nyng
[72]	663	local_pf(i,j,nzb+1) = precipitation_amount(j,i)
	664	ENDDO
	665	ENDDO
[1353]	666	precipitation_amount = 0.0_wp ! reset for next integ. interval
[72]	667	resorted = .TRUE.
	668	two_d = .TRUE.
	669	level_z(nzb+1) = zu(nzb+1)
	670
	671	CASE ( 'prr*_xy' ) ! 2d-array
[1053]	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
[1320]	700	local_pf(i,j,nzb+1) = prr_av(nzb+1,j,i) * &
	701	hyrho(nzb+1)
[1053]	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' )
[72]	711	IF ( av == 0 ) THEN
[1053]	712	CALL exchange_horiz( prr, nbgp )
[667]	713	DO i = nxlg, nxrg
	714	DO j = nysg, nyng
[1053]	715	DO k = nzb, nzt+1
	716	local_pf(i,j,k) = prr(k,j,i)
	717	ENDDO
[72]	718	ENDDO
	719	ENDDO
	720	ELSE
[1053]	721	CALL exchange_horiz( prr_av, nbgp )
[667]	722	DO i = nxlg, nxrg
	723	DO j = nysg, nyng
[1053]	724	DO k = nzb, nzt+1
	725	local_pf(i,j,k) = prr_av(k,j,i)
	726	ENDDO
[72]	727	ENDDO
	728	ENDDO
	729	ENDIF
	730	resorted = .TRUE.
[1053]	731	IF ( mode == 'xy' ) level_z = zu
[72]	732
[1]	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
[667]	738	DO i = nxlg, nxrg
	739	DO j = nysg, nyng
[1]	740	DO k = nzb, nzt+1
[1320]	741	local_pf(i,j,k) = pt(k,j,i) + l_d_cp * &
	742	pt_d_t(k) * &
[1]	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
[1053]	762	CASE ( 'qc_xy', 'qc_xz', 'qc_yz' )
[1]	763	IF ( av == 0 ) THEN
[1115]	764	to_be_resorted => qc
[1]	765	ELSE
[1115]	766	to_be_resorted => qc_av
[1]	767	ENDIF
	768	IF ( mode == 'xy' ) level_z = zu
	769
[1053]	770	CASE ( 'ql_xy', 'ql_xz', 'ql_yz' )
	771	IF ( av == 0 ) THEN
[1115]	772	to_be_resorted => ql
[1053]	773	ELSE
[1115]	774	to_be_resorted => ql_av
[1053]	775	ENDIF
	776	IF ( mode == 'xy' ) level_z = zu
	777
[1]	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
[1007]	796	IF ( simulated_time >= particle_advection_start ) THEN
	797	DO i = nxl, nxr
	798	DO j = nys, nyn
	799	DO k = nzb, nzt+1
[1359]	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
[1007]	809	ENDDO
	810	ENDDO
	811	ENDDO
	812	ENDDO
	813	CALL exchange_horiz( tend, nbgp )
	814	ELSE
[1353]	815	tend = 0.0_wp
[1359]	816	ENDIF
[1007]	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 )
[1]	827	to_be_resorted => ql_vp
	828	ENDIF
	829	IF ( mode == 'xy' ) level_z = zu
	830
[1053]	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
[354]	839	CASE ( 'qsws*_xy' ) ! 2d-array
	840	IF ( av == 0 ) THEN
[667]	841	DO i = nxlg, nxrg
	842	DO j = nysg, nyng
[354]	843	local_pf(i,j,nzb+1) = qsws(j,i)
	844	ENDDO
	845	ENDDO
	846	ELSE
[667]	847	DO i = nxlg, nxrg
	848	DO j = nysg, nyng
[354]	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
[1551]	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
[1]	929	CASE ( 'qv_xy', 'qv_xz', 'qv_yz' )
	930	IF ( av == 0 ) THEN
[667]	931	DO i = nxlg, nxrg
	932	DO j = nysg, nyng
[1]	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
[1551]	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
[1585]	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
[1551]	966	ELSE
[1585]	967	to_be_resorted => rad_lw_in_av
[1551]	968	ENDIF
[1701]	969	IF ( mode == 'xy' ) level_z = zu
[1551]	970
[1585]	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
[1701]	977	IF ( mode == 'xy' ) level_z = zu
[1585]	978
[1691]	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
[1701]	985	IF ( mode == 'xy' ) level_z = zw
[1691]	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
[1701]	993	IF ( mode == 'xy' ) level_z = zw
[1691]	994
[1585]	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
[1701]	1001	IF ( mode == 'xy' ) level_z = zu
[1585]	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
[1701]	1009	IF ( mode == 'xy' ) level_z = zu
[1585]	1010
[1691]	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
[1701]	1017	IF ( mode == 'xy' ) level_z = zw
[1691]	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
[1701]	1025	IF ( mode == 'xy' ) level_z = zw
[1691]	1026
[96]	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
[1555]	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
[1]	1070	CASE ( 's_xy', 's_xz', 's_yz' )
	1071	IF ( av == 0 ) THEN
	1072	to_be_resorted => q
	1073	ELSE
[355]	1074	to_be_resorted => s_av
[1]	1075	ENDIF
	1076
[96]	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
[354]	1084	CASE ( 'shf*_xy' ) ! 2d-array
	1085	IF ( av == 0 ) THEN
[667]	1086	DO i = nxlg, nxrg
	1087	DO j = nysg, nyng
[354]	1088	local_pf(i,j,nzb+1) = shf(j,i)
	1089	ENDDO
	1090	ENDDO
	1091	ELSE
[667]	1092	DO i = nxlg, nxrg
	1093	DO j = nysg, nyng
[354]	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
[1551]	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
[1]	1120	CASE ( 't*_xy' ) ! 2d-array
	1121	IF ( av == 0 ) THEN
[667]	1122	DO i = nxlg, nxrg
	1123	DO j = nysg, nyng
[1]	1124	local_pf(i,j,nzb+1) = ts(j,i)
	1125	ENDDO
	1126	ENDDO
	1127	ELSE
[667]	1128	DO i = nxlg, nxrg
	1129	DO j = nysg, nyng
[1]	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
[1551]	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
[1]	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
[1353]	1159	IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0_wp
[1]	1160	ENDIF
	1161
	1162	CASE ( 'u*_xy' ) ! 2d-array
	1163	IF ( av == 0 ) THEN
[667]	1164	DO i = nxlg, nxrg
	1165	DO j = nysg, nyng
[1]	1166	local_pf(i,j,nzb+1) = us(j,i)
	1167	ENDDO
	1168	ENDDO
	1169	ELSE
[667]	1170	DO i = nxlg, nxrg
	1171	DO j = nysg, nyng
[1]	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
[1353]	1191	IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0_wp
[1]	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
[72]	1210	CASE ( 'z0*_xy' ) ! 2d-array
	1211	IF ( av == 0 ) THEN
[667]	1212	DO i = nxlg, nxrg
	1213	DO j = nysg, nyng
[72]	1214	local_pf(i,j,nzb+1) = z0(j,i)
	1215	ENDDO
	1216	ENDDO
	1217	ELSE
[667]	1218	DO i = nxlg, nxrg
	1219	DO j = nysg, nyng
[72]	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
[978]	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
[1]	1246	CASE DEFAULT
	1247	!
	1248	!-- User defined quantity
[1320]	1249	CALL user_data_output_2d( av, do2d(av,if), found, grid, &
[1551]	1250	local_pf, two_d, nzb_do, nzt_do )
[1]	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
[343]	1257	ELSEIF ( grid == 'zu1' ) THEN
	1258	IF ( mode == 'xy' ) level_z(nzb+1) = zu(nzb+1)
[1551]	1259	ELSEIF ( grid == 'zs' ) THEN
	1260	IF ( mode == 'xy' ) level_z = zs
[1]	1261	ENDIF
	1262
	1263	IF ( .NOT. found ) THEN
[1320]	1264	message_string = 'no output provided for: ' // &
[274]	1265	TRIM( do2d(av,if) )
[254]	1266	CALL message( 'data_output_2d', 'PA0181', 0, 0, 0, 6, 0 )
[1]	1267	ENDIF
	1268
	1269	END SELECT
	1270
	1271	!
	1272	!-- Resort the array to be output, if not done above
	1273	IF ( .NOT. resorted ) THEN
[667]	1274	DO i = nxlg, nxrg
	1275	DO j = nysg, nyng
[1551]	1276	DO k = nzb_do, nzt_do
[1]	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
[1551]	1287	loop1: DO WHILE ( section(is,s) /= -9999 .OR. two_d )
[1]	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	!
[1551]	1301	!-- Exit the loop for layers beyond the data output domain
	1302	!-- (used for soil model)
[1691]	1303	IF ( layer_xy > nzt_do ) THEN
[1551]	1304	EXIT loop1
	1305	ENDIF
	1306
	1307	!
[1308]	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
[1327]	1315	IF ( .NOT. data_output_2d_on_each_pe &
	1316	.OR. netcdf_data_format > 4 ) &
[493]	1317	THEN
[1]	1318	#if defined( __netcdf )
	1319	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
	1320	id_var_time_xy(av), &
[291]	1321	(/ time_since_reference_point /), &
[1]	1322	start = (/ do2d_xy_time_count(av) /), &
	1323	count = (/ 1 /) )
[493]	1324	CALL handle_netcdf_error( 'data_output_2d', 53 )
[1]	1325	#endif
	1326	ENDIF
	1327	ENDIF
	1328	ENDIF
	1329	!
	1330	!-- If required, carry out averaging along z
[336]	1331	IF ( section(is,s) == -1 .AND. .NOT. two_d ) THEN
[1]	1332
[1353]	1333	local_2d = 0.0_wp
[1]	1334	!
	1335	!-- Carry out the averaging (all data are on the PE)
[1551]	1336	DO k = nzb_do, nzt_do
[667]	1337	DO j = nysg, nyng
	1338	DO i = nxlg, nxrg
[1]	1339	local_2d(i,j) = local_2d(i,j) + local_pf(i,j,k)
	1340	ENDDO
	1341	ENDDO
	1342	ENDDO
	1343
[1551]	1344	local_2d = local_2d / ( nzt_do - nzb_do + 1.0_wp)
[1]	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 )
[1327]	1354	IF ( netcdf_data_format > 4 ) THEN
[1]	1355	!
[1031]	1356	!-- Parallel output in netCDF4/HDF5 format.
[493]	1357	IF ( two_d ) THEN
	1358	iis = 1
	1359	ELSE
	1360	iis = is
	1361	ENDIF
	1362
[1]	1363	#if defined( __netcdf )
[1308]	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
[1]	1373	#endif
[493]	1374	ELSE
[1]	1375
[493]	1376	IF ( data_output_2d_on_each_pe ) THEN
[1]	1377	!
[493]	1378	!-- Output of partial arrays on each PE
	1379	#if defined( __netcdf )
[1327]	1380	IF ( myid == 0 ) THEN
[1320]	1381	WRITE ( 21 ) time_since_reference_point, &
[493]	1382	do2d_xy_time_count(av), av
	1383	ENDIF
	1384	#endif
[759]	1385	DO i = 0, io_blocks-1
	1386	IF ( i == io_group ) THEN
[1551]	1387	WRITE ( 21 ) nxlg, nxrg, nysg, nyng, nysg, nyng
[759]	1388	WRITE ( 21 ) local_2d
	1389	ENDIF
	1390	#if defined( __parallel )
	1391	CALL MPI_BARRIER( comm2d, ierr )
	1392	#endif
	1393	ENDDO
[559]	1394
[493]	1395	ELSE
[1]	1396	!
[493]	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
[667]	1403	ngp = ( nxrg-nxlg+1 ) * ( nyng-nysg+1 )
[493]	1404	IF ( myid == 0 ) THEN
[1]	1405	!
[493]	1406	!-- Local array can be relocated directly.
[667]	1407	total_2d(nxlg:nxrg,nysg:nyng) = local_2d
[1]	1408	!
[493]	1409	!-- Receive data from all other PEs.
	1410	DO n = 1, numprocs-1
[1]	1411	!
[493]	1412	!-- Receive index limits first, then array.
	1413	!-- Index limits are received in arbitrary order from
	1414	!-- the PEs.
[1320]	1415	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
	1416	MPI_ANY_SOURCE, 0, comm2d, &
[493]	1417	status, ierr )
	1418	sender = status(MPI_SOURCE)
	1419	DEALLOCATE( local_2d )
	1420	ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
[1320]	1421	CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
	1422	MPI_REAL, sender, 1, comm2d, &
[493]	1423	status, ierr )
	1424	total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
	1425	ENDDO
[1]	1426	!
[493]	1427	!-- Relocate the local array for the next loop increment
	1428	DEALLOCATE( local_2d )
[667]	1429	ALLOCATE( local_2d(nxlg:nxrg,nysg:nyng) )
[1]	1430
	1431	#if defined( __netcdf )
[1327]	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 /) )
[1]	1444	ENDIF
[1327]	1445	CALL handle_netcdf_error( 'data_output_2d', 54 )
[1]	1446	#endif
	1447
[493]	1448	ELSE
[1]	1449	!
[493]	1450	!-- First send the local index limits to PE0
[667]	1451	ind(1) = nxlg; ind(2) = nxrg
	1452	ind(3) = nysg; ind(4) = nyng
[1320]	1453	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
[493]	1454	comm2d, ierr )
[1]	1455	!
[493]	1456	!-- Send data to PE0
[1320]	1457	CALL MPI_SEND( local_2d(nxlg,nysg), ngp, &
[493]	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 )
[1]	1465	ENDIF
[493]	1466
[1]	1467	ENDIF
	1468	#else
	1469	#if defined( __netcdf )
[1327]	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 /) )
[1]	1482	ENDIF
[1327]	1483	CALL handle_netcdf_error( 'data_output_2d', 447 )
[1]	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
[1703]	1491	IF ( netcdf_data_format < 5 ) two_d = .FALSE.
[1]	1492	EXIT loop1
	1493	ENDIF
	1494
	1495	CASE ( 'xz' )
	1496	!
[1308]	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
[1327]	1504	IF ( .NOT. data_output_2d_on_each_pe &
	1505	.OR. netcdf_data_format > 4 ) &
[493]	1506	THEN
[1]	1507	#if defined( __netcdf )
	1508	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
	1509	id_var_time_xz(av), &
[291]	1510	(/ time_since_reference_point /), &
[1]	1511	start = (/ do2d_xz_time_count(av) /), &
	1512	count = (/ 1 /) )
[493]	1513	CALL handle_netcdf_error( 'data_output_2d', 56 )
[1]	1514	#endif
	1515	ENDIF
	1516	ENDIF
	1517	ENDIF
[667]	1518
[1]	1519	!
	1520	!-- If required, carry out averaging along y
	1521	IF ( section(is,s) == -1 ) THEN
	1522
[1551]	1523	ALLOCATE( local_2d_l(nxlg:nxrg,nzb_do:nzt_do) )
[1353]	1524	local_2d_l = 0.0_wp
[1551]	1525	ngp = ( nxrg-nxlg + 1 ) * ( nzt_do-nzb_do + 1 )
[1]	1526	!
	1527	!-- First local averaging on the PE
[1551]	1528	DO k = nzb_do, nzt_do
[1]	1529	DO j = nys, nyn
[667]	1530	DO i = nxlg, nxrg
[1320]	1531	local_2d_l(i,k) = local_2d_l(i,k) + &
[1]	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
[622]	1539	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
[1551]	1540	CALL MPI_ALLREDUCE( local_2d_l(nxlg,nzb_do), &
	1541	local_2d(nxlg,nzb_do), ngp, MPI_REAL, &
[1]	1542	MPI_SUM, comm1dy, ierr )
	1543	#else
	1544	local_2d = local_2d_l
	1545	#endif
[1353]	1546	local_2d = local_2d / ( ny + 1.0_wp )
[1]	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
[1551]	1556	local_2d = local_pf(:,section(is,s),nzb_do:nzt_do)
[1]	1557	ENDIF
	1558
	1559	ENDIF
	1560
	1561	#if defined( __parallel )
[1327]	1562	IF ( netcdf_data_format > 4 ) THEN
[1]	1563	!
[1031]	1564	!-- Output in netCDF4/HDF5 format.
[493]	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).
[1320]	1568	IF ( ( section(is,s) >= nys .AND. &
	1569	section(is,s) <= nyn ) .OR. &
[493]	1570	( section(is,s) == -1 .AND. myidy == 0 ) ) THEN
[1]	1571	#if defined( __netcdf )
[493]	1572	!
[1308]	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
[1551]	1577	DO k = nzb_do, nzt_do
[1308]	1578	local_2d_sections_l(i,is,k) = local_2d(i,k)
	1579	ENDDO
	1580	ENDDO
[1]	1581	#endif
	1582	ENDIF
	1583
	1584	ELSE
	1585
[493]	1586	IF ( data_output_2d_on_each_pe ) THEN
[1]	1587	!
[493]	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 )
[1327]	1592	IF ( myid == 0 ) THEN
[1320]	1593	WRITE ( 22 ) time_since_reference_point, &
[493]	1594	do2d_xz_time_count(av), av
	1595	ENDIF
	1596	#endif
[759]	1597	DO i = 0, io_blocks-1
	1598	IF ( i == io_group ) THEN
[1320]	1599	IF ( ( section(is,s) >= nys .AND. &
	1600	section(is,s) <= nyn ) .OR. &
	1601	( section(is,s) == -1 .AND. &
	1602	nys-1 == -1 ) ) &
[759]	1603	THEN
[1551]	1604	WRITE (22) nxlg, nxrg, nzb_do, nzt_do, nzb, nzt+1
[759]	1605	WRITE (22) local_2d
	1606	ELSE
[1551]	1607	WRITE (22) -1, -1, -1, -1, -1, -1
[759]	1608	ENDIF
	1609	ENDIF
	1610	#if defined( __parallel )
	1611	CALL MPI_BARRIER( comm2d, ierr )
	1612	#endif
	1613	ENDDO
[493]	1614
	1615	ELSE
[1]	1616	!
[493]	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
[1551]	1623	ngp = ( nxrg-nxlg + 1 ) * ( nzt_do-nzb_do + 1 )
[493]	1624	IF ( myid == 0 ) THEN
[1]	1625	!
[493]	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
[1551]	1631	total_2d(nxlg:nxrg,nzb_do:nzt_do) = local_2d
[493]	1632	ENDIF
[1]	1633	!
[493]	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.
[1320]	1640	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
	1641	MPI_ANY_SOURCE, 0, comm2d, &
[1]	1642	status, ierr )
[493]	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 )
[1320]	1648	ALLOCATE( local_2d(ind(1):ind(2), &
[493]	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 )
[1320]	1653	total_2d(ind(1):ind(2),ind(3):ind(4)) = &
[493]	1654	local_2d
	1655	ENDIF
	1656	ENDDO
	1657	!
	1658	!-- Relocate the local array for the next loop increment
	1659	DEALLOCATE( local_2d )
[1551]	1660	ALLOCATE( local_2d(nxlg:nxrg,nzb_do:nzt_do) )
[1]	1661
	1662	#if defined( __netcdf )
[1327]	1663	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
	1664	id_var_do2d(av,if), &
[1551]	1665	total_2d(0:nx+1,nzb_do:nzt_do),&
[1327]	1666	start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
[1551]	1667	count = (/ nx+2, 1, nzt_do-nzb_do+1, 1 /) )
[1327]	1668	CALL handle_netcdf_error( 'data_output_2d', 58 )
[1]	1669	#endif
	1670
[493]	1671	ELSE
[1]	1672	!
[493]	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
[667]	1679	ind(1) = nxlg; ind(2) = nxrg
[1551]	1680	ind(3) = nzb_do; ind(4) = nzt_do
[493]	1681	ELSE
	1682	ind(1) = -9999; ind(2) = -9999
	1683	ind(3) = -9999; ind(4) = -9999
	1684	ENDIF
[1320]	1685	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
[493]	1686	comm2d, ierr )
	1687	!
	1688	!-- If applicable, send data to PE0.
	1689	IF ( ind(1) /= -9999 ) THEN
[1551]	1690	CALL MPI_SEND( local_2d(nxlg,nzb_do), ngp, &
[493]	1691	MPI_REAL, 0, 1, comm2d, ierr )
	1692	ENDIF
[1]	1693	ENDIF
	1694	!
[493]	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 )
[1]	1699	ENDIF
[493]	1700
[1]	1701	ENDIF
	1702	#else
	1703	#if defined( __netcdf )
[1327]	1704	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
	1705	id_var_do2d(av,if), &
[1551]	1706	local_2d(nxl:nxr+1,nzb_do:nzt_do), &
[1327]	1707	start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
[1551]	1708	count = (/ nx+2, 1, nzt_do-nzb_do+1, 1 /) )
[1327]	1709	CALL handle_netcdf_error( 'data_output_2d', 451 )
[1]	1710	#endif
	1711	#endif
	1712	do2d_xz_n = do2d_xz_n + 1
	1713
	1714	CASE ( 'yz' )
	1715	!
[1308]	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
[1327]	1723	IF ( .NOT. data_output_2d_on_each_pe &
	1724	.OR. netcdf_data_format > 4 ) &
[493]	1725	THEN
[1]	1726	#if defined( __netcdf )
	1727	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
	1728	id_var_time_yz(av), &
[291]	1729	(/ time_since_reference_point /), &
[1]	1730	start = (/ do2d_yz_time_count(av) /), &
	1731	count = (/ 1 /) )
[263]	1732	CALL handle_netcdf_error( 'data_output_2d', 59 )
[1]	1733	#endif
	1734	ENDIF
	1735	ENDIF
[1308]	1736	ENDIF
[493]	1737
[1]	1738	!
	1739	!-- If required, carry out averaging along x
	1740	IF ( section(is,s) == -1 ) THEN
	1741
[1551]	1742	ALLOCATE( local_2d_l(nysg:nyng,nzb_do:nzt_do) )
[1353]	1743	local_2d_l = 0.0_wp
[1551]	1744	ngp = ( nyng-nysg+1 ) * ( nzt_do-nzb_do+1 )
[1]	1745	!
	1746	!-- First local averaging on the PE
[1551]	1747	DO k = nzb_do, nzt_do
[667]	1748	DO j = nysg, nyng
[1]	1749	DO i = nxl, nxr
[1320]	1750	local_2d_l(j,k) = local_2d_l(j,k) + &
[1]	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
[622]	1758	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
[1551]	1759	CALL MPI_ALLREDUCE( local_2d_l(nysg,nzb_do), &
	1760	local_2d(nysg,nzb_do), ngp, MPI_REAL, &
[1]	1761	MPI_SUM, comm1dx, ierr )
	1762	#else
	1763	local_2d = local_2d_l
	1764	#endif
[1353]	1765	local_2d = local_2d / ( nx + 1.0_wp )
[1]	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
[1551]	1775	local_2d = local_pf(section(is,s),:,nzb_do:nzt_do)
[1]	1776	ENDIF
	1777
	1778	ENDIF
	1779
	1780	#if defined( __parallel )
[1327]	1781	IF ( netcdf_data_format > 4 ) THEN
[1]	1782	!
[1031]	1783	!-- Output in netCDF4/HDF5 format.
[493]	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).
[1320]	1787	IF ( ( section(is,s) >= nxl .AND. &
	1788	section(is,s) <= nxr ) .OR. &
[493]	1789	( section(is,s) == -1 .AND. myidx == 0 ) ) THEN
[1]	1790	#if defined( __netcdf )
[493]	1791	!
[1308]	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
[1551]	1796	DO k = nzb_do, nzt_do
[1308]	1797	local_2d_sections_l(is,j,k) = local_2d(j,k)
	1798	ENDDO
	1799	ENDDO
[1]	1800	#endif
	1801	ENDIF
	1802
	1803	ELSE
	1804
[493]	1805	IF ( data_output_2d_on_each_pe ) THEN
[1]	1806	!
[493]	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 )
[1327]	1811	IF ( myid == 0 ) THEN
[1320]	1812	WRITE ( 23 ) time_since_reference_point, &
[493]	1813	do2d_yz_time_count(av), av
	1814	ENDIF
	1815	#endif
[759]	1816	DO i = 0, io_blocks-1
	1817	IF ( i == io_group ) THEN
[1320]	1818	IF ( ( section(is,s) >= nxl .AND. &
	1819	section(is,s) <= nxr ) .OR. &
	1820	( section(is,s) == -1 .AND. &
	1821	nxl-1 == -1 ) ) &
[759]	1822	THEN
[1551]	1823	WRITE (23) nysg, nyng, nzb_do, nzt_do, nzb, nzt+1
[759]	1824	WRITE (23) local_2d
	1825	ELSE
[1551]	1826	WRITE (23) -1, -1, -1, -1, -1, -1
[759]	1827	ENDIF
	1828	ENDIF
	1829	#if defined( __parallel )
	1830	CALL MPI_BARRIER( comm2d, ierr )
	1831	#endif
	1832	ENDDO
[493]	1833
	1834	ELSE
[1]	1835	!
[493]	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
[1551]	1842	ngp = ( nyng-nysg+1 ) * ( nzt_do-nzb_do+1 )
[493]	1843	IF ( myid == 0 ) THEN
[1]	1844	!
[493]	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
[1551]	1850	total_2d(nysg:nyng,nzb_do:nzt_do) = local_2d
[493]	1851	ENDIF
[1]	1852	!
[493]	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.
[1320]	1859	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
	1860	MPI_ANY_SOURCE, 0, comm2d, &
[1]	1861	status, ierr )
[493]	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 )
[1320]	1867	ALLOCATE( local_2d(ind(1):ind(2), &
[493]	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 )
[1320]	1872	total_2d(ind(1):ind(2),ind(3):ind(4)) = &
[493]	1873	local_2d
	1874	ENDIF
	1875	ENDDO
	1876	!
	1877	!-- Relocate the local array for the next loop increment
	1878	DEALLOCATE( local_2d )
[1551]	1879	ALLOCATE( local_2d(nysg:nyng,nzb_do:nzt_do) )
[1]	1880
	1881	#if defined( __netcdf )
[1327]	1882	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
	1883	id_var_do2d(av,if), &
[1551]	1884	total_2d(0:ny+1,nzb_do:nzt_do),&
[1327]	1885	start = (/ is, 1, 1, do2d_yz_time_count(av) /), &
[1551]	1886	count = (/ 1, ny+2, nzt_do-nzb_do+1, 1 /) )
[1327]	1887	CALL handle_netcdf_error( 'data_output_2d', 61 )
[1]	1888	#endif
	1889
[493]	1890	ELSE
[1]	1891	!
[493]	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
[667]	1898	ind(1) = nysg; ind(2) = nyng
[1551]	1899	ind(3) = nzb_do; ind(4) = nzt_do
[493]	1900	ELSE
	1901	ind(1) = -9999; ind(2) = -9999
	1902	ind(3) = -9999; ind(4) = -9999
	1903	ENDIF
[1320]	1904	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
[493]	1905	comm2d, ierr )
	1906	!
	1907	!-- If applicable, send data to PE0.
	1908	IF ( ind(1) /= -9999 ) THEN
[1551]	1909	CALL MPI_SEND( local_2d(nysg,nzb_do), ngp, &
[493]	1910	MPI_REAL, 0, 1, comm2d, ierr )
	1911	ENDIF
[1]	1912	ENDIF
	1913	!
[493]	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 )
[1]	1918	ENDIF
[493]	1919
[1]	1920	ENDIF
	1921	#else
	1922	#if defined( __netcdf )
[1327]	1923	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
	1924	id_var_do2d(av,if), &
[1551]	1925	local_2d(nys:nyn+1,nzb_do:nzt_do), &
[1327]	1926	start = (/ is, 1, 1, do2d_xz_time_count(av) /), &
[1551]	1927	count = (/ 1, ny+2, nzt_do-nzb_do+1, 1 /) )
[1327]	1928	CALL handle_netcdf_error( 'data_output_2d', 452 )
[1]	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
[1308]	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 )
[1327]	1943	IF ( netcdf_data_format > 4 ) THEN
[1308]	1944
	1945	SELECT CASE ( mode )
	1946
	1947	CASE ( 'xy' )
	1948	IF ( two_d ) THEN
[1703]	1949	nis = 1
	1950	two_d = .FALSE.
[1308]	1951	ELSE
[1703]	1952	nis = ns
[1308]	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, &
[1703]	1961	nys:nyn,1:nis), &
[1308]	1962	start = (/ nxl+1, nys+1, 1, &
	1963	do2d_xy_time_count(av) /), &
	1964	count = (/ nxr-nxl+2, &
[1703]	1965	nyn-nys+1, nis, 1 &
[1308]	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, &
[1703]	1971	nys:nyn+1,1:nis), &
[1308]	1972	start = (/ nxl+1, nys+1, 1, &
	1973	do2d_xy_time_count(av) /), &
	1974	count = (/ nxr-nxl+1, &
[1703]	1975	nyn-nys+2, nis, 1 &
[1308]	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, &
[1703]	1981	nys:nyn+1,1:nis), &
[1308]	1982	start = (/ nxl+1, nys+1, 1, &
	1983	do2d_xy_time_count(av) /), &
	1984	count = (/ nxr-nxl+2, &
[1703]	1985	nyn-nys+2, nis, 1 &
[1308]	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, &
[1703]	1991	nys:nyn,1:nis), &
[1308]	1992	start = (/ nxl+1, nys+1, 1, &
	1993	do2d_xy_time_count(av) /), &
	1994	count = (/ nxr-nxl+1, &
[1703]	1995	nyn-nys+1, nis, 1 &
[1308]	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
[1551]	2016	ngp = ( nxrg-nxlg+1 ) * ( nzt_do-nzb_do+1 ) * ns
[1308]	2017	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
[1551]	2018	CALL MPI_ALLREDUCE( local_2d_sections_l(nxlg,1,nzb_do), &
	2019	local_2d_sections(nxlg,1,nzb_do), &
[1308]	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, &
[1551]	2033	nzb_do:nzt_do), &
[1308]	2034	start = (/ nxl+1, 1, 1, &
	2035	do2d_xz_time_count(av) /), &
[1551]	2036	count = (/ nxr-nxl+2, ns, nzt_do-nzb_do+1, &
[1308]	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, &
[1551]	2042	nzb_do:nzt_do), &
[1308]	2043	start = (/ nxl+1, 1, 1, &
	2044	do2d_xz_time_count(av) /), &
[1551]	2045	count = (/ nxr-nxl+1, ns, nzt_do-nzb_do+1, &
[1308]	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 )
[1551]	2068	CALL MPI_ALLREDUCE( local_2d_sections_l(1,nysg,nzb_do), &
	2069	local_2d_sections(1,nysg,nzb_do), &
[1308]	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, &
[1551]	2083	nys:nyn+1,nzb_do:nzt_do), &
[1308]	2084	start = (/ 1, nys+1, 1, &
	2085	do2d_yz_time_count(av) /), &
	2086	count = (/ ns, nyn-nys+2, &
[1551]	2087	nzt_do-nzb_do+1, 1 /) )
[1308]	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, &
[1551]	2092	nzb_do:nzt_do), &
[1308]	2093	start = (/ 1, nys+1, 1, &
	2094	do2d_yz_time_count(av) /), &
	2095	count = (/ ns, nyn-nys+1, &
[1551]	2096	nzt_do-nzb_do+1, 1 /) )
[1308]	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
[1311]	2108	#endif
[1]	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 )
[1308]	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
[1]	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
[759]	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
[1]	2143	ELSE
	2144	IF ( myid == 0 ) CALL close_file( file_id )
	2145	ENDIF
	2146
[1318]	2147	CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
[1]	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 |