Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |