Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |