Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |