Home

Context Navigation

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

Last change on this file since 1325 was 1321, checked in by raasch, 11 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 76.6 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |