Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |