Home

Context Navigation

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

Last change on this file since 4222 was 4182, checked in by scharf, 5 years ago
corrected "Former revisions" section minor formatting in "Former revisions" section added "Author" section
Property svn:keywords set to `Id`
File size: 89.5 KB

Rev	Line
[1682]	1	!> @file data_output_2d.f90
[2000]	2	!------------------------------------------------------------------------------!
[2696]	3	! This file is part of the PALM model system.
[1036]	4	!
[2000]	5	! PALM is free software: you can redistribute it and/or modify it under the
	6	! terms of the GNU General Public License as published by the Free Software
	7	! Foundation, either version 3 of the License, or (at your option) any later
	8	! version.
[1036]	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	!
[3655]	17	! Copyright 1997-2019 Leibniz Universitaet Hannover
[2000]	18	!------------------------------------------------------------------------------!
[1036]	19	!
[254]	20	! Current revisions:
[3569]	21	! ------------------
[1961]	22	!
[3589]	23	!
[1552]	24	! Former revisions:
	25	! -----------------
	26	! $Id: data_output_2d.f90 4182 2019-08-22 15:20:23Z gronemeier $
[4182]	27	! Corrected "Former revisions" section
	28	!
	29	! 4048 2019-06-21 21:00:21Z knoop
[4048]	30	! Removed turbulence_closure_mod dependency
	31	!
	32	! 4039 2019-06-18 10:32:41Z suehring
[4039]	33	! modularize diagnostic output
	34	!
	35	! 3994 2019-05-22 18:08:09Z suehring
[3994]	36	! output of turbulence intensity added
	37	!
	38	! 3987 2019-05-22 09:52:13Z kanani
[3987]	39	! Introduce alternative switch for debug output during timestepping
	40	!
	41	! 3943 2019-05-02 09:50:41Z maronga
[3943]	42	! Added output of qsws for green roofs.
	43	!
	44	! 3885 2019-04-11 11:29:34Z kanani
[3885]	45	! Changes related to global restructuring of location messages and introduction
	46	! of additional debug messages
	47	!
	48	! 3766 2019-02-26 16:23:41Z raasch
[3766]	49	! unused variables removed
	50	!
	51	! 3655 2019-01-07 16:51:22Z knoop
[3646]	52	! Bugfix: use time_since_reference_point instead of simulated_time (relevant
	53	! when using wall/soil spinup)
[3569]	54	!
[4182]	55	! Revision 1.1 1997/08/11 06:24:09 raasch
	56	! Initial revision
	57	!
	58	!
[1]	59	! Description:
	60	! ------------
[2512]	61	!> Data output of cross-sections in netCDF format or binary format
	62	!> to be later converted to NetCDF by helper routine combine_plot_fields.
[1682]	63	!> Attention: The position of the sectional planes is still not always computed
	64	!> --------- correctly. (zu is used always)!
[1]	65	!------------------------------------------------------------------------------!
[1682]	66	SUBROUTINE data_output_2d( mode, av )
	67
[1]	68
[3766]	69	USE arrays_3d, &
	70	ONLY: dzw, d_exner, e, heatflux_output_conversion, p, pt, q, ql, ql_c, ql_v, s, tend, u, &
	71	v, vpt, w, waterflux_output_conversion, zu, zw
[3274]	72
[1]	73	USE averaging
[3274]	74
	75	USE basic_constants_and_equations_mod, &
	76	ONLY: c_p, lv_d_cp, l_v
	77
	78	USE bulk_cloud_model_mod, &
[3637]	79	ONLY: bulk_cloud_model
[3274]	80
[1320]	81	USE control_parameters, &
[3637]	82	ONLY: data_output_2d_on_each_pe, &
[3885]	83	data_output_xy, data_output_xz, data_output_yz, &
[3987]	84	debug_output_timestep, &
[3885]	85	do2d, &
[2277]	86	do2d_xy_last_time, do2d_xy_time_count, &
	87	do2d_xz_last_time, do2d_xz_time_count, &
	88	do2d_yz_last_time, do2d_yz_time_count, &
[3637]	89	ibc_uv_b, io_blocks, io_group, message_string, &
[1822]	90	ntdim_2d_xy, ntdim_2d_xz, ntdim_2d_yz, &
[3646]	91	psolver, section, &
[3569]	92	time_since_reference_point
[3274]	93
[1320]	94	USE cpulog, &
[3637]	95	ONLY: cpu_log, log_point
[3274]	96
[1320]	97	USE indices, &
[3241]	98	ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, &
[3004]	99	nzb, nzt, wall_flags_0
[3274]	100
[1320]	101	USE kinds
[3274]	102
[1551]	103	USE land_surface_model_mod, &
[3637]	104	ONLY: zs
[3274]	105
[3637]	106	USE module_interface, &
	107	ONLY: module_interface_data_output_2d
	108
[1783]	109	#if defined( __netcdf )
	110	USE NETCDF
	111	#endif
[1320]	112
[1783]	113	USE netcdf_interface, &
[2696]	114	ONLY: fill_value, id_set_xy, id_set_xz, id_set_yz, id_var_do2d, &
	115	id_var_time_xy, id_var_time_xz, id_var_time_yz, nc_stat, &
	116	netcdf_data_format, netcdf_handle_error
[1783]	117
[1320]	118	USE particle_attributes, &
[1359]	119	ONLY: grid_particles, number_of_particles, particle_advection_start, &
	120	particles, prt_count
[1320]	121
[1]	122	USE pegrid
	123
[2232]	124	USE surface_mod, &
[2963]	125	ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_def_h, &
	126	surf_lsm_h, surf_usm_h
[2232]	127
[2696]	128
[1]	129	IMPLICIT NONE
	130
[3554]	131	CHARACTER (LEN=2) :: do2d_mode !< output mode of variable ('xy', 'xz', 'yz')
	132	CHARACTER (LEN=2) :: mode !< mode with which the routine is called ('xy', 'xz', 'yz')
	133	CHARACTER (LEN=4) :: grid !< string defining the vertical grid
[1320]	134
[3554]	135	INTEGER(iwp) :: av !< flag for (non-)average output
	136	INTEGER(iwp) :: ngp !< number of grid points of an output slice
	137	INTEGER(iwp) :: file_id !< id of output files
[2696]	138	INTEGER(iwp) :: flag_nr !< number of masking flag
[3554]	139	INTEGER(iwp) :: i !< loop index
	140	INTEGER(iwp) :: iis !< vertical index of a xy slice in array 'local_2d_sections'
	141	INTEGER(iwp) :: is !< slice index
	142	INTEGER(iwp) :: ivar !< variable index
	143	INTEGER(iwp) :: j !< loop index
	144	INTEGER(iwp) :: k !< loop index
	145	INTEGER(iwp) :: l !< loop index
	146	INTEGER(iwp) :: layer_xy !< vertical index of a xy slice in array 'local_pf'
	147	INTEGER(iwp) :: m !< loop index
	148	INTEGER(iwp) :: n !< loop index
	149	INTEGER(iwp) :: nis !< number of vertical slices to be written via parallel NetCDF output
	150	INTEGER(iwp) :: ns !< number of output slices
[1682]	151	INTEGER(iwp) :: nzb_do !< lower limit of the data field (usually nzb)
	152	INTEGER(iwp) :: nzt_do !< upper limit of the data field (usually nzt+1)
[3554]	153	INTEGER(iwp) :: s_ind !< index of slice types (xy=1, xz=2, yz=3)
	154	INTEGER(iwp) :: sender !< PE id of sending PE
	155	INTEGER(iwp) :: ind(4) !< index limits (lower/upper bounds) of array 'local_2d'
	156
	157	LOGICAL :: found !< true if output variable was found
	158	LOGICAL :: resorted !< true if variable is resorted
	159	LOGICAL :: two_d !< true if variable is only two dimensional
	160
	161	REAL(wp) :: mean_r !< mean particle radius
	162	REAL(wp) :: s_r2 !< sum( particle-radius**2 )
	163	REAL(wp) :: s_r3 !< sum( particle-radius**3 )
[1320]	164
[3554]	165	REAL(wp), DIMENSION(:), ALLOCATABLE :: level_z !< z levels for output array
	166	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: local_2d !< local 2-dimensional array containing output values
	167	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: local_2d_l !< local 2-dimensional array containing output values
[2232]	168
[3554]	169	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !< output array
	170	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_2d_sections !< local array containing values at all slices
	171	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_2d_sections_l !< local array containing values at all slices
[1359]	172
[1]	173	#if defined( __parallel )
[3554]	174	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: total_2d !< same as local_2d
[1]	175	#endif
[3554]	176	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which shall be output
[1]	177
[3885]	178
[3987]	179	IF ( debug_output_timestep ) CALL debug_message( 'data_output_2d', 'start' )
[1]	180	!
	181	!-- Immediate return, if no output is requested (no respective sections
	182	!-- found in parameter data_output)
	183	IF ( mode == 'xy' .AND. .NOT. data_output_xy(av) ) RETURN
	184	IF ( mode == 'xz' .AND. .NOT. data_output_xz(av) ) RETURN
	185	IF ( mode == 'yz' .AND. .NOT. data_output_yz(av) ) RETURN
	186
[1308]	187	CALL cpu_log (log_point(3),'data_output_2d','start')
	188
[1]	189	two_d = .FALSE. ! local variable to distinguish between output of pure 2D
	190	! arrays and cross-sections of 3D arrays.
	191
	192	!
	193	!-- Depending on the orientation of the cross-section, the respective output
	194	!-- files have to be opened.
	195	SELECT CASE ( mode )
	196
	197	CASE ( 'xy' )
[1960]	198	s_ind = 1
[2512]	199	ALLOCATE( level_z(nzb:nzt+1), local_2d(nxl:nxr,nys:nyn) )
[1]	200
[1308]	201	IF ( netcdf_data_format > 4 ) THEN
	202	ns = 1
[1960]	203	DO WHILE ( section(ns,s_ind) /= -9999 .AND. ns <= 100 )
[1308]	204	ns = ns + 1
	205	ENDDO
	206	ns = ns - 1
[2512]	207	ALLOCATE( local_2d_sections(nxl:nxr,nys:nyn,1:ns) )
[1353]	208	local_2d_sections = 0.0_wp
[1308]	209	ENDIF
	210
[493]	211	!
[1031]	212	!-- Parallel netCDF4/HDF5 output is done on all PEs, all other on PE0 only
[1327]	213	IF ( myid == 0 .OR. netcdf_data_format > 4 ) THEN
[493]	214	CALL check_open( 101+av*10 )
	215	ENDIF
[3052]	216	IF ( data_output_2d_on_each_pe .AND. netcdf_data_format < 5 ) THEN
[1]	217	CALL check_open( 21 )
	218	ELSE
	219	IF ( myid == 0 ) THEN
	220	#if defined( __parallel )
[2512]	221	ALLOCATE( total_2d(0:nx,0:ny) )
[1]	222	#endif
	223	ENDIF
	224	ENDIF
	225
	226	CASE ( 'xz' )
[1960]	227	s_ind = 2
[2512]	228	ALLOCATE( local_2d(nxl:nxr,nzb:nzt+1) )
[1]	229
[1308]	230	IF ( netcdf_data_format > 4 ) THEN
	231	ns = 1
[1960]	232	DO WHILE ( section(ns,s_ind) /= -9999 .AND. ns <= 100 )
[1308]	233	ns = ns + 1
	234	ENDDO
	235	ns = ns - 1
[2512]	236	ALLOCATE( local_2d_sections(nxl:nxr,1:ns,nzb:nzt+1) )
	237	ALLOCATE( local_2d_sections_l(nxl:nxr,1:ns,nzb:nzt+1) )
[1353]	238	local_2d_sections = 0.0_wp; local_2d_sections_l = 0.0_wp
[1308]	239	ENDIF
	240
[493]	241	!
[1031]	242	!-- Parallel netCDF4/HDF5 output is done on all PEs, all other on PE0 only
[1327]	243	IF ( myid == 0 .OR. netcdf_data_format > 4 ) THEN
[493]	244	CALL check_open( 102+av*10 )
	245	ENDIF
[1]	246
[3052]	247	IF ( data_output_2d_on_each_pe .AND. netcdf_data_format < 5 ) THEN
[1]	248	CALL check_open( 22 )
	249	ELSE
	250	IF ( myid == 0 ) THEN
	251	#if defined( __parallel )
[2512]	252	ALLOCATE( total_2d(0:nx,nzb:nzt+1) )
[1]	253	#endif
	254	ENDIF
	255	ENDIF
	256
	257	CASE ( 'yz' )
[1960]	258	s_ind = 3
[2512]	259	ALLOCATE( local_2d(nys:nyn,nzb:nzt+1) )
[1]	260
[1308]	261	IF ( netcdf_data_format > 4 ) THEN
	262	ns = 1
[1960]	263	DO WHILE ( section(ns,s_ind) /= -9999 .AND. ns <= 100 )
[1308]	264	ns = ns + 1
	265	ENDDO
	266	ns = ns - 1
[2512]	267	ALLOCATE( local_2d_sections(1:ns,nys:nyn,nzb:nzt+1) )
	268	ALLOCATE( local_2d_sections_l(1:ns,nys:nyn,nzb:nzt+1) )
[1353]	269	local_2d_sections = 0.0_wp; local_2d_sections_l = 0.0_wp
[1308]	270	ENDIF
	271
[493]	272	!
[1031]	273	!-- Parallel netCDF4/HDF5 output is done on all PEs, all other on PE0 only
[1327]	274	IF ( myid == 0 .OR. netcdf_data_format > 4 ) THEN
[493]	275	CALL check_open( 103+av*10 )
	276	ENDIF
[1]	277
[3052]	278	IF ( data_output_2d_on_each_pe .AND. netcdf_data_format < 5 ) THEN
[1]	279	CALL check_open( 23 )
	280	ELSE
	281	IF ( myid == 0 ) THEN
	282	#if defined( __parallel )
[2512]	283	ALLOCATE( total_2d(0:ny,nzb:nzt+1) )
[1]	284	#endif
	285	ENDIF
	286	ENDIF
	287
	288	CASE DEFAULT
[254]	289	message_string = 'unknown cross-section: ' // TRIM( mode )
	290	CALL message( 'data_output_2d', 'PA0180', 1, 2, 0, 6, 0 )
[1]	291
	292	END SELECT
	293
	294	!
[1745]	295	!-- For parallel netcdf output the time axis must be limited. Return, if this
	296	!-- limit is exceeded. This could be the case, if the simulated time exceeds
	297	!-- the given end time by the length of the given output interval.
	298	IF ( netcdf_data_format > 4 ) THEN
	299	IF ( mode == 'xy' .AND. do2d_xy_time_count(av) + 1 > &
	300	ntdim_2d_xy(av) ) THEN
	301	WRITE ( message_string, * ) 'Output of xy cross-sections is not ', &
[3646]	302	'given at t=', time_since_reference_point, 's because the', &
[1745]	303	' maximum number of output time levels is exceeded.'
	304	CALL message( 'data_output_2d', 'PA0384', 0, 1, 0, 6, 0 )
	305	CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
	306	RETURN
	307	ENDIF
	308	IF ( mode == 'xz' .AND. do2d_xz_time_count(av) + 1 > &
	309	ntdim_2d_xz(av) ) THEN
	310	WRITE ( message_string, * ) 'Output of xz cross-sections is not ', &
[3646]	311	'given at t=', time_since_reference_point, 's because the', &
[1745]	312	' maximum number of output time levels is exceeded.'
	313	CALL message( 'data_output_2d', 'PA0385', 0, 1, 0, 6, 0 )
	314	CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
	315	RETURN
	316	ENDIF
	317	IF ( mode == 'yz' .AND. do2d_yz_time_count(av) + 1 > &
	318	ntdim_2d_yz(av) ) THEN
	319	WRITE ( message_string, * ) 'Output of yz cross-sections is not ', &
[3646]	320	'given at t=', time_since_reference_point, 's because the', &
[1745]	321	' maximum number of output time levels is exceeded.'
	322	CALL message( 'data_output_2d', 'PA0386', 0, 1, 0, 6, 0 )
	323	CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
	324	RETURN
	325	ENDIF
	326	ENDIF
	327
	328	!
[1]	329	!-- Allocate a temporary array for resorting (kji -> ijk).
[2512]	330	ALLOCATE( local_pf(nxl:nxr,nys:nyn,nzb:nzt+1) )
[2232]	331	local_pf = 0.0
[1]	332
	333	!
	334	!-- Loop of all variables to be written.
	335	!-- Output dimensions chosen
[3554]	336	ivar = 1
	337	l = MAX( 2, LEN_TRIM( do2d(av,ivar) ) )
	338	do2d_mode = do2d(av,ivar)(l-1:l)
[1]	339
[3554]	340	DO WHILE ( do2d(av,ivar)(1:1) /= ' ' )
[1]	341
	342	IF ( do2d_mode == mode ) THEN
[1980]	343	!
	344	!-- Set flag to steer output of radiation, land-surface, or user-defined
	345	!-- quantities
	346	found = .FALSE.
[1551]	347
	348	nzb_do = nzb
	349	nzt_do = nzt+1
[1]	350	!
[2696]	351	!-- Before each output, set array local_pf to fill value
	352	local_pf = fill_value
	353	!
	354	!-- Set masking flag for topography for not resorted arrays
	355	flag_nr = 0
	356
	357	!
[1]	358	!-- Store the array chosen on the temporary array.
	359	resorted = .FALSE.
[3554]	360	SELECT CASE ( TRIM( do2d(av,ivar) ) )
[1]	361	CASE ( 'e_xy', 'e_xz', 'e_yz' )
	362	IF ( av == 0 ) THEN
	363	to_be_resorted => e
	364	ELSE
[3004]	365	IF ( .NOT. ALLOCATED( e_av ) ) THEN
	366	ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	367	e_av = REAL( fill_value, KIND = wp )
	368	ENDIF
[1]	369	to_be_resorted => e_av
	370	ENDIF
	371	IF ( mode == 'xy' ) level_z = zu
	372
[3421]	373	CASE ( 'thetal_xy', 'thetal_xz', 'thetal_yz' )
[771]	374	IF ( av == 0 ) THEN
	375	to_be_resorted => pt
	376	ELSE
[3004]	377	IF ( .NOT. ALLOCATED( lpt_av ) ) THEN
	378	ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	379	lpt_av = REAL( fill_value, KIND = wp )
	380	ENDIF
[771]	381	to_be_resorted => lpt_av
	382	ENDIF
	383	IF ( mode == 'xy' ) level_z = zu
	384
[1]	385	CASE ( 'lwp*_xy' ) ! 2d-array
	386	IF ( av == 0 ) THEN
[2512]	387	DO i = nxl, nxr
	388	DO j = nys, nyn
[1320]	389	local_pf(i,j,nzb+1) = SUM( ql(nzb:nzt,j,i) * &
[1]	390	dzw(1:nzt+1) )
	391	ENDDO
	392	ENDDO
	393	ELSE
[3004]	394	IF ( .NOT. ALLOCATED( lwp_av ) ) THEN
	395	ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
	396	lwp_av = REAL( fill_value, KIND = wp )
	397	ENDIF
[2512]	398	DO i = nxl, nxr
	399	DO j = nys, nyn
[1]	400	local_pf(i,j,nzb+1) = lwp_av(j,i)
	401	ENDDO
	402	ENDDO
	403	ENDIF
	404	resorted = .TRUE.
	405	two_d = .TRUE.
	406	level_z(nzb+1) = zu(nzb+1)
	407
[2797]	408	CASE ( 'ghf*_xy' ) ! 2d-array
	409	IF ( av == 0 ) THEN
	410	DO m = 1, surf_lsm_h%ns
	411	i = surf_lsm_h%i(m)
	412	j = surf_lsm_h%j(m)
	413	local_pf(i,j,nzb+1) = surf_lsm_h%ghf(m)
	414	ENDDO
	415	DO m = 1, surf_usm_h%ns
	416	i = surf_usm_h%i(m)
	417	j = surf_usm_h%j(m)
[2963]	418	local_pf(i,j,nzb+1) = surf_usm_h%frac(ind_veg_wall,m) * &
[2797]	419	surf_usm_h%wghf_eb(m) + &
[2963]	420	surf_usm_h%frac(ind_pav_green,m) * &
[2797]	421	surf_usm_h%wghf_eb_green(m) + &
[2963]	422	surf_usm_h%frac(ind_wat_win,m) * &
[2797]	423	surf_usm_h%wghf_eb_window(m)
	424	ENDDO
	425	ELSE
[3004]	426	IF ( .NOT. ALLOCATED( ghf_av ) ) THEN
	427	ALLOCATE( ghf_av(nysg:nyng,nxlg:nxrg) )
	428	ghf_av = REAL( fill_value, KIND = wp )
	429	ENDIF
[2797]	430	DO i = nxl, nxr
	431	DO j = nys, nyn
	432	local_pf(i,j,nzb+1) = ghf_av(j,i)
	433	ENDDO
	434	ENDDO
	435	ENDIF
	436
	437	resorted = .TRUE.
	438	two_d = .TRUE.
	439	level_z(nzb+1) = zu(nzb+1)
	440
[1691]	441	CASE ( 'ol*_xy' ) ! 2d-array
	442	IF ( av == 0 ) THEN
[2232]	443	DO m = 1, surf_def_h(0)%ns
	444	i = surf_def_h(0)%i(m)
	445	j = surf_def_h(0)%j(m)
[2512]	446	local_pf(i,j,nzb+1) = surf_def_h(0)%ol(m)
[2232]	447	ENDDO
	448	DO m = 1, surf_lsm_h%ns
	449	i = surf_lsm_h%i(m)
	450	j = surf_lsm_h%j(m)
[2512]	451	local_pf(i,j,nzb+1) = surf_lsm_h%ol(m)
[2232]	452	ENDDO
	453	DO m = 1, surf_usm_h%ns
	454	i = surf_usm_h%i(m)
	455	j = surf_usm_h%j(m)
[2512]	456	local_pf(i,j,nzb+1) = surf_usm_h%ol(m)
[2232]	457	ENDDO
[1691]	458	ELSE
[3004]	459	IF ( .NOT. ALLOCATED( ol_av ) ) THEN
	460	ALLOCATE( ol_av(nysg:nyng,nxlg:nxrg) )
	461	ol_av = REAL( fill_value, KIND = wp )
	462	ENDIF
[2512]	463	DO i = nxl, nxr
	464	DO j = nys, nyn
[1691]	465	local_pf(i,j,nzb+1) = ol_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
[1]	473	CASE ( 'p_xy', 'p_xz', 'p_yz' )
	474	IF ( av == 0 ) THEN
[729]	475	IF ( psolver /= 'sor' ) CALL exchange_horiz( p, nbgp )
[1]	476	to_be_resorted => p
	477	ELSE
[3004]	478	IF ( .NOT. ALLOCATED( p_av ) ) THEN
	479	ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	480	p_av = REAL( fill_value, KIND = wp )
	481	ENDIF
[729]	482	IF ( psolver /= 'sor' ) CALL exchange_horiz( p_av, nbgp )
[1]	483	to_be_resorted => p_av
	484	ENDIF
	485	IF ( mode == 'xy' ) level_z = zu
	486
	487	CASE ( 'pc_xy', 'pc_xz', 'pc_yz' ) ! particle concentration
	488	IF ( av == 0 ) THEN
[3646]	489	IF ( time_since_reference_point >= particle_advection_start ) THEN
[215]	490	tend = prt_count
[2512]	491	! CALL exchange_horiz( tend, nbgp )
[215]	492	ELSE
[1353]	493	tend = 0.0_wp
[215]	494	ENDIF
[2512]	495	DO i = nxl, nxr
	496	DO j = nys, nyn
[1]	497	DO k = nzb, nzt+1
	498	local_pf(i,j,k) = tend(k,j,i)
	499	ENDDO
	500	ENDDO
	501	ENDDO
	502	resorted = .TRUE.
	503	ELSE
[3004]	504	IF ( .NOT. ALLOCATED( pc_av ) ) THEN
	505	ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	506	pc_av = REAL( fill_value, KIND = wp )
	507	ENDIF
[2512]	508	! CALL exchange_horiz( pc_av, nbgp )
[1]	509	to_be_resorted => pc_av
	510	ENDIF
	511
[1359]	512	CASE ( 'pr_xy', 'pr_xz', 'pr_yz' ) ! mean particle radius (effective radius)
[1]	513	IF ( av == 0 ) THEN
[3646]	514	IF ( time_since_reference_point >= particle_advection_start ) THEN
[215]	515	DO i = nxl, nxr
	516	DO j = nys, nyn
	517	DO k = nzb, nzt+1
[1359]	518	number_of_particles = prt_count(k,j,i)
	519	IF (number_of_particles <= 0) CYCLE
	520	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
	521	s_r2 = 0.0_wp
[1353]	522	s_r3 = 0.0_wp
[1359]	523	DO n = 1, number_of_particles
	524	IF ( particles(n)%particle_mask ) THEN
	525	s_r2 = s_r2 + particles(n)%radius*2 &
	526	particles(n)%weight_factor
	527	s_r3 = s_r3 + particles(n)%radius*3 &
	528	particles(n)%weight_factor
	529	ENDIF
[215]	530	ENDDO
[1359]	531	IF ( s_r2 > 0.0_wp ) THEN
	532	mean_r = s_r3 / s_r2
[215]	533	ELSE
[1353]	534	mean_r = 0.0_wp
[215]	535	ENDIF
	536	tend(k,j,i) = mean_r
[1]	537	ENDDO
	538	ENDDO
	539	ENDDO
[2512]	540	! CALL exchange_horiz( tend, nbgp )
[215]	541	ELSE
[1353]	542	tend = 0.0_wp
[1359]	543	ENDIF
[2512]	544	DO i = nxl, nxr
	545	DO j = nys, nyn
[1]	546	DO k = nzb, nzt+1
	547	local_pf(i,j,k) = tend(k,j,i)
	548	ENDDO
	549	ENDDO
	550	ENDDO
	551	resorted = .TRUE.
	552	ELSE
[3004]	553	IF ( .NOT. ALLOCATED( pr_av ) ) THEN
	554	ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	555	pr_av = REAL( fill_value, KIND = wp )
	556	ENDIF
[2512]	557	! CALL exchange_horiz( pr_av, nbgp )
[1]	558	to_be_resorted => pr_av
	559	ENDIF
	560
[3421]	561	CASE ( 'theta_xy', 'theta_xz', 'theta_yz' )
[1]	562	IF ( av == 0 ) THEN
[3274]	563	IF ( .NOT. bulk_cloud_model ) THEN
[1]	564	to_be_resorted => pt
	565	ELSE
[2512]	566	DO i = nxl, nxr
	567	DO j = nys, nyn
[1]	568	DO k = nzb, nzt+1
[3274]	569	local_pf(i,j,k) = pt(k,j,i) + lv_d_cp * &
	570	d_exner(k) * &
[1]	571	ql(k,j,i)
	572	ENDDO
	573	ENDDO
	574	ENDDO
	575	resorted = .TRUE.
	576	ENDIF
	577	ELSE
[3004]	578	IF ( .NOT. ALLOCATED( pt_av ) ) THEN
	579	ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	580	pt_av = REAL( fill_value, KIND = wp )
	581	ENDIF
[1]	582	to_be_resorted => pt_av
	583	ENDIF
	584	IF ( mode == 'xy' ) level_z = zu
	585
	586	CASE ( 'q_xy', 'q_xz', 'q_yz' )
	587	IF ( av == 0 ) THEN
	588	to_be_resorted => q
	589	ELSE
[3004]	590	IF ( .NOT. ALLOCATED( q_av ) ) THEN
	591	ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	592	q_av = REAL( fill_value, KIND = wp )
	593	ENDIF
[1]	594	to_be_resorted => q_av
	595	ENDIF
	596	IF ( mode == 'xy' ) level_z = zu
	597
[1053]	598	CASE ( 'ql_xy', 'ql_xz', 'ql_yz' )
	599	IF ( av == 0 ) THEN
[1115]	600	to_be_resorted => ql
[1053]	601	ELSE
[3004]	602	IF ( .NOT. ALLOCATED( ql_av ) ) THEN
	603	ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	604	ql_av = REAL( fill_value, KIND = wp )
	605	ENDIF
[1115]	606	to_be_resorted => ql_av
[1053]	607	ENDIF
	608	IF ( mode == 'xy' ) level_z = zu
	609
[1]	610	CASE ( 'ql_c_xy', 'ql_c_xz', 'ql_c_yz' )
	611	IF ( av == 0 ) THEN
	612	to_be_resorted => ql_c
	613	ELSE
[3004]	614	IF ( .NOT. ALLOCATED( ql_c_av ) ) THEN
	615	ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	616	ql_c_av = REAL( fill_value, KIND = wp )
	617	ENDIF
[1]	618	to_be_resorted => ql_c_av
	619	ENDIF
	620	IF ( mode == 'xy' ) level_z = zu
	621
	622	CASE ( 'ql_v_xy', 'ql_v_xz', 'ql_v_yz' )
	623	IF ( av == 0 ) THEN
	624	to_be_resorted => ql_v
	625	ELSE
[3004]	626	IF ( .NOT. ALLOCATED( ql_v_av ) ) THEN
	627	ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	628	ql_v_av = REAL( fill_value, KIND = wp )
	629	ENDIF
[1]	630	to_be_resorted => ql_v_av
	631	ENDIF
	632	IF ( mode == 'xy' ) level_z = zu
	633
	634	CASE ( 'ql_vp_xy', 'ql_vp_xz', 'ql_vp_yz' )
	635	IF ( av == 0 ) THEN
[3646]	636	IF ( time_since_reference_point >= particle_advection_start ) THEN
[1007]	637	DO i = nxl, nxr
	638	DO j = nys, nyn
	639	DO k = nzb, nzt+1
[1359]	640	number_of_particles = prt_count(k,j,i)
	641	IF (number_of_particles <= 0) CYCLE
	642	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
	643	DO n = 1, number_of_particles
	644	IF ( particles(n)%particle_mask ) THEN
	645	tend(k,j,i) = tend(k,j,i) + &
	646	particles(n)%weight_factor / &
	647	prt_count(k,j,i)
	648	ENDIF
[1007]	649	ENDDO
	650	ENDDO
	651	ENDDO
	652	ENDDO
[2512]	653	! CALL exchange_horiz( tend, nbgp )
[1007]	654	ELSE
[1353]	655	tend = 0.0_wp
[1359]	656	ENDIF
[2512]	657	DO i = nxl, nxr
	658	DO j = nys, nyn
[1007]	659	DO k = nzb, nzt+1
	660	local_pf(i,j,k) = tend(k,j,i)
	661	ENDDO
	662	ENDDO
	663	ENDDO
	664	resorted = .TRUE.
	665	ELSE
[3004]	666	IF ( .NOT. ALLOCATED( ql_vp_av ) ) THEN
	667	ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	668	ql_vp_av = REAL( fill_value, KIND = wp )
	669	ENDIF
[2512]	670	! CALL exchange_horiz( ql_vp_av, nbgp )
[3004]	671	to_be_resorted => ql_vp_av
[1]	672	ENDIF
	673	IF ( mode == 'xy' ) level_z = zu
	674
[354]	675	CASE ( 'qsws*_xy' ) ! 2d-array
	676	IF ( av == 0 ) THEN
[3176]	677	local_pf(:,:,nzb+1) = REAL( fill_value, KIND = wp )
[2743]	678	!
	679	!-- In case of default surfaces, clean-up flux by density.
[3176]	680	!-- In case of land-surfaces, convert fluxes into
[2743]	681	!-- dynamic units
[2232]	682	DO m = 1, surf_def_h(0)%ns
	683	i = surf_def_h(0)%i(m)
	684	j = surf_def_h(0)%j(m)
[2743]	685	k = surf_def_h(0)%k(m)
	686	local_pf(i,j,nzb+1) = surf_def_h(0)%qsws(m) * &
	687	waterflux_output_conversion(k)
[2232]	688	ENDDO
	689	DO m = 1, surf_lsm_h%ns
	690	i = surf_lsm_h%i(m)
	691	j = surf_lsm_h%j(m)
[2743]	692	k = surf_lsm_h%k(m)
	693	local_pf(i,j,nzb+1) = surf_lsm_h%qsws(m) * l_v
[2232]	694	ENDDO
[3943]	695	DO m = 1, surf_usm_h%ns
	696	i = surf_usm_h%i(m)
	697	j = surf_usm_h%j(m)
	698	k = surf_usm_h%k(m)
	699	local_pf(i,j,nzb+1) = surf_usm_h%qsws(m) * l_v
	700	ENDDO
[354]	701	ELSE
[3004]	702	IF ( .NOT. ALLOCATED( qsws_av ) ) THEN
	703	ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
	704	qsws_av = REAL( fill_value, KIND = wp )
	705	ENDIF
[2512]	706	DO i = nxl, nxr
	707	DO j = nys, nyn
[354]	708	local_pf(i,j,nzb+1) = qsws_av(j,i)
	709	ENDDO
	710	ENDDO
	711	ENDIF
	712	resorted = .TRUE.
	713	two_d = .TRUE.
	714	level_z(nzb+1) = zu(nzb+1)
	715
[1]	716	CASE ( 'qv_xy', 'qv_xz', 'qv_yz' )
	717	IF ( av == 0 ) THEN
[2512]	718	DO i = nxl, nxr
	719	DO j = nys, nyn
[1]	720	DO k = nzb, nzt+1
	721	local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
	722	ENDDO
	723	ENDDO
	724	ENDDO
	725	resorted = .TRUE.
	726	ELSE
[3004]	727	IF ( .NOT. ALLOCATED( qv_av ) ) THEN
	728	ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	729	qv_av = REAL( fill_value, KIND = wp )
	730	ENDIF
[1]	731	to_be_resorted => qv_av
	732	ENDIF
	733	IF ( mode == 'xy' ) level_z = zu
	734
[2735]	735	CASE ( 'r_a*_xy' ) ! 2d-array
	736	IF ( av == 0 ) THEN
	737	DO m = 1, surf_lsm_h%ns
	738	i = surf_lsm_h%i(m)
	739	j = surf_lsm_h%j(m)
	740	local_pf(i,j,nzb+1) = surf_lsm_h%r_a(m)
	741	ENDDO
[1551]	742
[2735]	743	DO m = 1, surf_usm_h%ns
	744	i = surf_usm_h%i(m)
	745	j = surf_usm_h%j(m)
	746	local_pf(i,j,nzb+1) = &
[2963]	747	( surf_usm_h%frac(ind_veg_wall,m) * &
	748	surf_usm_h%r_a(m) + &
	749	surf_usm_h%frac(ind_pav_green,m) * &
	750	surf_usm_h%r_a_green(m) + &
	751	surf_usm_h%frac(ind_wat_win,m) * &
	752	surf_usm_h%r_a_window(m) )
[2735]	753	ENDDO
	754	ELSE
[3004]	755	IF ( .NOT. ALLOCATED( r_a_av ) ) THEN
	756	ALLOCATE( r_a_av(nysg:nyng,nxlg:nxrg) )
	757	r_a_av = REAL( fill_value, KIND = wp )
	758	ENDIF
[2735]	759	DO i = nxl, nxr
	760	DO j = nys, nyn
	761	local_pf(i,j,nzb+1) = r_a_av(j,i)
	762	ENDDO
	763	ENDDO
	764	ENDIF
	765	resorted = .TRUE.
	766	two_d = .TRUE.
	767	level_z(nzb+1) = zu(nzb+1)
	768
[1]	769	CASE ( 's_xy', 's_xz', 's_yz' )
	770	IF ( av == 0 ) THEN
[1960]	771	to_be_resorted => s
[1]	772	ELSE
[3004]	773	IF ( .NOT. ALLOCATED( s_av ) ) THEN
	774	ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	775	s_av = REAL( fill_value, KIND = wp )
	776	ENDIF
[355]	777	to_be_resorted => s_av
[1]	778	ENDIF
	779
[354]	780	CASE ( 'shf*_xy' ) ! 2d-array
	781	IF ( av == 0 ) THEN
[2743]	782	!
	783	!-- In case of default surfaces, clean-up flux by density.
	784	!-- In case of land- and urban-surfaces, convert fluxes into
	785	!-- dynamic units.
[2232]	786	DO m = 1, surf_def_h(0)%ns
	787	i = surf_def_h(0)%i(m)
	788	j = surf_def_h(0)%j(m)
[2743]	789	k = surf_def_h(0)%k(m)
	790	local_pf(i,j,nzb+1) = surf_def_h(0)%shf(m) * &
	791	heatflux_output_conversion(k)
[2232]	792	ENDDO
	793	DO m = 1, surf_lsm_h%ns
	794	i = surf_lsm_h%i(m)
	795	j = surf_lsm_h%j(m)
[2743]	796	k = surf_lsm_h%k(m)
[3274]	797	local_pf(i,j,nzb+1) = surf_lsm_h%shf(m) * c_p
[2232]	798	ENDDO
	799	DO m = 1, surf_usm_h%ns
	800	i = surf_usm_h%i(m)
	801	j = surf_usm_h%j(m)
[2743]	802	k = surf_usm_h%k(m)
[3274]	803	local_pf(i,j,nzb+1) = surf_usm_h%shf(m) * c_p
[2232]	804	ENDDO
[354]	805	ELSE
[3004]	806	IF ( .NOT. ALLOCATED( shf_av ) ) THEN
	807	ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
	808	shf_av = REAL( fill_value, KIND = wp )
	809	ENDIF
[2512]	810	DO i = nxl, nxr
	811	DO j = nys, nyn
[354]	812	local_pf(i,j,nzb+1) = shf_av(j,i)
	813	ENDDO
	814	ENDDO
	815	ENDIF
	816	resorted = .TRUE.
	817	two_d = .TRUE.
	818	level_z(nzb+1) = zu(nzb+1)
[1960]	819
	820	CASE ( 'ssws*_xy' ) ! 2d-array
	821	IF ( av == 0 ) THEN
[2232]	822	DO m = 1, surf_def_h(0)%ns
	823	i = surf_def_h(0)%i(m)
	824	j = surf_def_h(0)%j(m)
[2512]	825	local_pf(i,j,nzb+1) = surf_def_h(0)%ssws(m)
[2232]	826	ENDDO
	827	DO m = 1, surf_lsm_h%ns
	828	i = surf_lsm_h%i(m)
	829	j = surf_lsm_h%j(m)
[2512]	830	local_pf(i,j,nzb+1) = surf_lsm_h%ssws(m)
[2232]	831	ENDDO
	832	DO m = 1, surf_usm_h%ns
	833	i = surf_usm_h%i(m)
	834	j = surf_usm_h%j(m)
[2512]	835	local_pf(i,j,nzb+1) = surf_usm_h%ssws(m)
[2232]	836	ENDDO
[1960]	837	ELSE
[3004]	838	IF ( .NOT. ALLOCATED( ssws_av ) ) THEN
	839	ALLOCATE( ssws_av(nysg:nyng,nxlg:nxrg) )
	840	ssws_av = REAL( fill_value, KIND = wp )
	841	ENDIF
[2512]	842	DO i = nxl, nxr
	843	DO j = nys, nyn
[1960]	844	local_pf(i,j,nzb+1) = ssws_av(j,i)
	845	ENDDO
	846	ENDDO
	847	ENDIF
	848	resorted = .TRUE.
	849	two_d = .TRUE.
	850	level_z(nzb+1) = zu(nzb+1)
[1551]	851
[1]	852	CASE ( 't*_xy' ) ! 2d-array
	853	IF ( av == 0 ) THEN
[2232]	854	DO m = 1, surf_def_h(0)%ns
	855	i = surf_def_h(0)%i(m)
	856	j = surf_def_h(0)%j(m)
[2512]	857	local_pf(i,j,nzb+1) = surf_def_h(0)%ts(m)
[2232]	858	ENDDO
	859	DO m = 1, surf_lsm_h%ns
	860	i = surf_lsm_h%i(m)
	861	j = surf_lsm_h%j(m)
[2512]	862	local_pf(i,j,nzb+1) = surf_lsm_h%ts(m)
[2232]	863	ENDDO
	864	DO m = 1, surf_usm_h%ns
	865	i = surf_usm_h%i(m)
	866	j = surf_usm_h%j(m)
[2512]	867	local_pf(i,j,nzb+1) = surf_usm_h%ts(m)
[2232]	868	ENDDO
[1]	869	ELSE
[3004]	870	IF ( .NOT. ALLOCATED( ts_av ) ) THEN
	871	ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
	872	ts_av = REAL( fill_value, KIND = wp )
	873	ENDIF
[2512]	874	DO i = nxl, nxr
	875	DO j = nys, nyn
[1]	876	local_pf(i,j,nzb+1) = ts_av(j,i)
	877	ENDDO
	878	ENDDO
	879	ENDIF
	880	resorted = .TRUE.
	881	two_d = .TRUE.
	882	level_z(nzb+1) = zu(nzb+1)
	883
[2742]	884	CASE ( 'tsurf*_xy' ) ! 2d-array
	885	IF ( av == 0 ) THEN
[2798]	886	DO m = 1, surf_def_h(0)%ns
	887	i = surf_def_h(0)%i(m)
	888	j = surf_def_h(0)%j(m)
	889	local_pf(i,j,nzb+1) = surf_def_h(0)%pt_surface(m)
	890	ENDDO
	891
[2742]	892	DO m = 1, surf_lsm_h%ns
	893	i = surf_lsm_h%i(m)
	894	j = surf_lsm_h%j(m)
	895	local_pf(i,j,nzb+1) = surf_lsm_h%pt_surface(m)
	896	ENDDO
	897
	898	DO m = 1, surf_usm_h%ns
	899	i = surf_usm_h%i(m)
	900	j = surf_usm_h%j(m)
	901	local_pf(i,j,nzb+1) = surf_usm_h%pt_surface(m)
	902	ENDDO
	903
	904	ELSE
[3004]	905	IF ( .NOT. ALLOCATED( tsurf_av ) ) THEN
	906	ALLOCATE( tsurf_av(nysg:nyng,nxlg:nxrg) )
	907	tsurf_av = REAL( fill_value, KIND = wp )
	908	ENDIF
[2742]	909	DO i = nxl, nxr
	910	DO j = nys, nyn
	911	local_pf(i,j,nzb+1) = tsurf_av(j,i)
	912	ENDDO
	913	ENDDO
	914	ENDIF
	915	resorted = .TRUE.
	916	two_d = .TRUE.
	917	level_z(nzb+1) = zu(nzb+1)
	918
[1]	919	CASE ( 'u_xy', 'u_xz', 'u_yz' )
[2696]	920	flag_nr = 1
[1]	921	IF ( av == 0 ) THEN
	922	to_be_resorted => u
	923	ELSE
[3004]	924	IF ( .NOT. ALLOCATED( u_av ) ) THEN
	925	ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	926	u_av = REAL( fill_value, KIND = wp )
	927	ENDIF
[1]	928	to_be_resorted => u_av
	929	ENDIF
	930	IF ( mode == 'xy' ) level_z = zu
	931	!
	932	!-- Substitute the values generated by "mirror" boundary condition
	933	!-- at the bottom boundary by the real surface values.
[3554]	934	IF ( do2d(av,ivar) == 'u_xz' .OR. do2d(av,ivar) == 'u_yz' ) THEN
[1353]	935	IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0_wp
[1]	936	ENDIF
[4039]	937
[3421]	938	CASE ( 'us*_xy' ) ! 2d-array
[1]	939	IF ( av == 0 ) THEN
[2232]	940	DO m = 1, surf_def_h(0)%ns
	941	i = surf_def_h(0)%i(m)
	942	j = surf_def_h(0)%j(m)
[2512]	943	local_pf(i,j,nzb+1) = surf_def_h(0)%us(m)
[2232]	944	ENDDO
	945	DO m = 1, surf_lsm_h%ns
	946	i = surf_lsm_h%i(m)
	947	j = surf_lsm_h%j(m)
[2512]	948	local_pf(i,j,nzb+1) = surf_lsm_h%us(m)
[2232]	949	ENDDO
	950	DO m = 1, surf_usm_h%ns
	951	i = surf_usm_h%i(m)
	952	j = surf_usm_h%j(m)
[2512]	953	local_pf(i,j,nzb+1) = surf_usm_h%us(m)
[2232]	954	ENDDO
[1]	955	ELSE
[3004]	956	IF ( .NOT. ALLOCATED( us_av ) ) THEN
	957	ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
	958	us_av = REAL( fill_value, KIND = wp )
	959	ENDIF
[2512]	960	DO i = nxl, nxr
	961	DO j = nys, nyn
[1]	962	local_pf(i,j,nzb+1) = us_av(j,i)
	963	ENDDO
	964	ENDDO
	965	ENDIF
	966	resorted = .TRUE.
	967	two_d = .TRUE.
	968	level_z(nzb+1) = zu(nzb+1)
	969
	970	CASE ( 'v_xy', 'v_xz', 'v_yz' )
[2696]	971	flag_nr = 2
[1]	972	IF ( av == 0 ) THEN
	973	to_be_resorted => v
	974	ELSE
[3004]	975	IF ( .NOT. ALLOCATED( v_av ) ) THEN
	976	ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	977	v_av = REAL( fill_value, KIND = wp )
	978	ENDIF
[1]	979	to_be_resorted => v_av
	980	ENDIF
	981	IF ( mode == 'xy' ) level_z = zu
	982	!
	983	!-- Substitute the values generated by "mirror" boundary condition
	984	!-- at the bottom boundary by the real surface values.
[3554]	985	IF ( do2d(av,ivar) == 'v_xz' .OR. do2d(av,ivar) == 'v_yz' ) THEN
[1353]	986	IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0_wp
[1]	987	ENDIF
	988
[3421]	989	CASE ( 'thetav_xy', 'thetav_xz', 'thetav_yz' )
[1]	990	IF ( av == 0 ) THEN
	991	to_be_resorted => vpt
	992	ELSE
[3004]	993	IF ( .NOT. ALLOCATED( vpt_av ) ) THEN
	994	ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	995	vpt_av = REAL( fill_value, KIND = wp )
	996	ENDIF
[1]	997	to_be_resorted => vpt_av
	998	ENDIF
	999	IF ( mode == 'xy' ) level_z = zu
	1000
[3597]	1001	CASE ( 'theta_2m*_xy' ) ! 2d-array
	1002	IF ( av == 0 ) THEN
	1003	DO m = 1, surf_def_h(0)%ns
	1004	i = surf_def_h(0)%i(m)
	1005	j = surf_def_h(0)%j(m)
	1006	local_pf(i,j,nzb+1) = surf_def_h(0)%pt_2m(m)
	1007	ENDDO
	1008	DO m = 1, surf_lsm_h%ns
	1009	i = surf_lsm_h%i(m)
	1010	j = surf_lsm_h%j(m)
	1011	local_pf(i,j,nzb+1) = surf_lsm_h%pt_2m(m)
	1012	ENDDO
	1013	DO m = 1, surf_usm_h%ns
	1014	i = surf_usm_h%i(m)
	1015	j = surf_usm_h%j(m)
	1016	local_pf(i,j,nzb+1) = surf_usm_h%pt_2m(m)
	1017	ENDDO
	1018	ELSE
	1019	IF ( .NOT. ALLOCATED( pt_2m_av ) ) THEN
	1020	ALLOCATE( pt_2m_av(nysg:nyng,nxlg:nxrg) )
	1021	pt_2m_av = REAL( fill_value, KIND = wp )
	1022	ENDIF
	1023	DO i = nxl, nxr
	1024	DO j = nys, nyn
	1025	local_pf(i,j,nzb+1) = pt_2m_av(j,i)
	1026	ENDDO
	1027	ENDDO
	1028	ENDIF
	1029	resorted = .TRUE.
	1030	two_d = .TRUE.
	1031	level_z(nzb+1) = zu(nzb+1)
[3994]	1032
[1]	1033	CASE ( 'w_xy', 'w_xz', 'w_yz' )
[2696]	1034	flag_nr = 3
[1]	1035	IF ( av == 0 ) THEN
	1036	to_be_resorted => w
	1037	ELSE
[3004]	1038	IF ( .NOT. ALLOCATED( w_av ) ) THEN
	1039	ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
	1040	w_av = REAL( fill_value, KIND = wp )
	1041	ENDIF
[1]	1042	to_be_resorted => w_av
	1043	ENDIF
	1044	IF ( mode == 'xy' ) level_z = zw
	1045
[72]	1046	CASE ( 'z0*_xy' ) ! 2d-array
	1047	IF ( av == 0 ) THEN
[2232]	1048	DO m = 1, surf_def_h(0)%ns
	1049	i = surf_def_h(0)%i(m)
	1050	j = surf_def_h(0)%j(m)
[2512]	1051	local_pf(i,j,nzb+1) = surf_def_h(0)%z0(m)
[2232]	1052	ENDDO
	1053	DO m = 1, surf_lsm_h%ns
	1054	i = surf_lsm_h%i(m)
	1055	j = surf_lsm_h%j(m)
[2512]	1056	local_pf(i,j,nzb+1) = surf_lsm_h%z0(m)
[2232]	1057	ENDDO
	1058	DO m = 1, surf_usm_h%ns
	1059	i = surf_usm_h%i(m)
	1060	j = surf_usm_h%j(m)
[2512]	1061	local_pf(i,j,nzb+1) = surf_usm_h%z0(m)
[2232]	1062	ENDDO
[72]	1063	ELSE
[3004]	1064	IF ( .NOT. ALLOCATED( z0_av ) ) THEN
	1065	ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
	1066	z0_av = REAL( fill_value, KIND = wp )
	1067	ENDIF
[2512]	1068	DO i = nxl, nxr
	1069	DO j = nys, nyn
[72]	1070	local_pf(i,j,nzb+1) = z0_av(j,i)
	1071	ENDDO
	1072	ENDDO
	1073	ENDIF
	1074	resorted = .TRUE.
	1075	two_d = .TRUE.
	1076	level_z(nzb+1) = zu(nzb+1)
	1077
[978]	1078	CASE ( 'z0h*_xy' ) ! 2d-array
	1079	IF ( av == 0 ) THEN
[2232]	1080	DO m = 1, surf_def_h(0)%ns
	1081	i = surf_def_h(0)%i(m)
	1082	j = surf_def_h(0)%j(m)
[2512]	1083	local_pf(i,j,nzb+1) = surf_def_h(0)%z0h(m)
[2232]	1084	ENDDO
	1085	DO m = 1, surf_lsm_h%ns
	1086	i = surf_lsm_h%i(m)
	1087	j = surf_lsm_h%j(m)
[2512]	1088	local_pf(i,j,nzb+1) = surf_lsm_h%z0h(m)
[2232]	1089	ENDDO
	1090	DO m = 1, surf_usm_h%ns
	1091	i = surf_usm_h%i(m)
	1092	j = surf_usm_h%j(m)
[2512]	1093	local_pf(i,j,nzb+1) = surf_usm_h%z0h(m)
[2232]	1094	ENDDO
[978]	1095	ELSE
[3004]	1096	IF ( .NOT. ALLOCATED( z0h_av ) ) THEN
	1097	ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
	1098	z0h_av = REAL( fill_value, KIND = wp )
	1099	ENDIF
[2512]	1100	DO i = nxl, nxr
	1101	DO j = nys, nyn
[978]	1102	local_pf(i,j,nzb+1) = z0h_av(j,i)
	1103	ENDDO
	1104	ENDDO
	1105	ENDIF
	1106	resorted = .TRUE.
	1107	two_d = .TRUE.
	1108	level_z(nzb+1) = zu(nzb+1)
	1109
[1788]	1110	CASE ( 'z0q*_xy' ) ! 2d-array
	1111	IF ( av == 0 ) THEN
[2232]	1112	DO m = 1, surf_def_h(0)%ns
	1113	i = surf_def_h(0)%i(m)
	1114	j = surf_def_h(0)%j(m)
[2512]	1115	local_pf(i,j,nzb+1) = surf_def_h(0)%z0q(m)
[2232]	1116	ENDDO
	1117	DO m = 1, surf_lsm_h%ns
	1118	i = surf_lsm_h%i(m)
	1119	j = surf_lsm_h%j(m)
[2512]	1120	local_pf(i,j,nzb+1) = surf_lsm_h%z0q(m)
[2232]	1121	ENDDO
	1122	DO m = 1, surf_usm_h%ns
	1123	i = surf_usm_h%i(m)
	1124	j = surf_usm_h%j(m)
[2512]	1125	local_pf(i,j,nzb+1) = surf_usm_h%z0q(m)
[2232]	1126	ENDDO
[1788]	1127	ELSE
[3004]	1128	IF ( .NOT. ALLOCATED( z0q_av ) ) THEN
	1129	ALLOCATE( z0q_av(nysg:nyng,nxlg:nxrg) )
	1130	z0q_av = REAL( fill_value, KIND = wp )
	1131	ENDIF
[2512]	1132	DO i = nxl, nxr
	1133	DO j = nys, nyn
[1788]	1134	local_pf(i,j,nzb+1) = z0q_av(j,i)
	1135	ENDDO
	1136	ENDDO
	1137	ENDIF
	1138	resorted = .TRUE.
	1139	two_d = .TRUE.
	1140	level_z(nzb+1) = zu(nzb+1)
	1141
[1]	1142	CASE DEFAULT
[1972]	1143
[1]	1144	!
[3294]	1145	!-- Quantities of other modules
[1972]	1146	IF ( .NOT. found ) THEN
[3637]	1147	CALL module_interface_data_output_2d( &
	1148	av, do2d(av,ivar), found, grid, mode, &
	1149	local_pf, two_d, nzb_do, nzt_do, &
	1150	fill_value &
	1151	)
[1972]	1152	ENDIF
	1153
[1]	1154	resorted = .TRUE.
	1155
	1156	IF ( grid == 'zu' ) THEN
	1157	IF ( mode == 'xy' ) level_z = zu
	1158	ELSEIF ( grid == 'zw' ) THEN
	1159	IF ( mode == 'xy' ) level_z = zw
[343]	1160	ELSEIF ( grid == 'zu1' ) THEN
	1161	IF ( mode == 'xy' ) level_z(nzb+1) = zu(nzb+1)
[1551]	1162	ELSEIF ( grid == 'zs' ) THEN
	1163	IF ( mode == 'xy' ) level_z = zs
[1]	1164	ENDIF
	1165
	1166	IF ( .NOT. found ) THEN
[1320]	1167	message_string = 'no output provided for: ' // &
[3554]	1168	TRIM( do2d(av,ivar) )
[254]	1169	CALL message( 'data_output_2d', 'PA0181', 0, 0, 0, 6, 0 )
[1]	1170	ENDIF
	1171
	1172	END SELECT
	1173
	1174	!
[2696]	1175	!-- Resort the array to be output, if not done above. Flag topography
	1176	!-- grid points with fill values, using the corresponding maksing flag.
[1]	1177	IF ( .NOT. resorted ) THEN
[2512]	1178	DO i = nxl, nxr
	1179	DO j = nys, nyn
[1551]	1180	DO k = nzb_do, nzt_do
[2696]	1181	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
	1182	REAL( fill_value, KIND = wp ), &
	1183	BTEST( wall_flags_0(k,j,i), &
	1184	flag_nr ) )
[1]	1185	ENDDO
	1186	ENDDO
	1187	ENDDO
	1188	ENDIF
	1189
	1190	!
	1191	!-- Output of the individual cross-sections, depending on the cross-
	1192	!-- section mode chosen.
	1193	is = 1
[1960]	1194	loop1: DO WHILE ( section(is,s_ind) /= -9999 .OR. two_d )
[1]	1195
	1196	SELECT CASE ( mode )
	1197
	1198	CASE ( 'xy' )
	1199	!
	1200	!-- Determine the cross section index
	1201	IF ( two_d ) THEN
	1202	layer_xy = nzb+1
	1203	ELSE
[1960]	1204	layer_xy = section(is,s_ind)
[1]	1205	ENDIF
	1206
	1207	!
[1551]	1208	!-- Exit the loop for layers beyond the data output domain
	1209	!-- (used for soil model)
[1691]	1210	IF ( layer_xy > nzt_do ) THEN
[1551]	1211	EXIT loop1
	1212	ENDIF
	1213
	1214	!
[1308]	1215	!-- Update the netCDF xy cross section time axis.
	1216	!-- In case of parallel output, this is only done by PE0
	1217	!-- to increase the performance.
[3646]	1218	IF ( time_since_reference_point /= do2d_xy_last_time(av) ) THEN
[1308]	1219	do2d_xy_time_count(av) = do2d_xy_time_count(av) + 1
[3646]	1220	do2d_xy_last_time(av) = time_since_reference_point
[1308]	1221	IF ( myid == 0 ) THEN
[1327]	1222	IF ( .NOT. data_output_2d_on_each_pe &
	1223	.OR. netcdf_data_format > 4 ) &
[493]	1224	THEN
[1]	1225	#if defined( __netcdf )
	1226	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
	1227	id_var_time_xy(av), &
[291]	1228	(/ time_since_reference_point /), &
[1]	1229	start = (/ do2d_xy_time_count(av) /), &
	1230	count = (/ 1 /) )
[1783]	1231	CALL netcdf_handle_error( 'data_output_2d', 53 )
[1]	1232	#endif
	1233	ENDIF
	1234	ENDIF
	1235	ENDIF
	1236	!
	1237	!-- If required, carry out averaging along z
[1960]	1238	IF ( section(is,s_ind) == -1 .AND. .NOT. two_d ) THEN
[1]	1239
[1353]	1240	local_2d = 0.0_wp
[1]	1241	!
	1242	!-- Carry out the averaging (all data are on the PE)
[1551]	1243	DO k = nzb_do, nzt_do
[2512]	1244	DO j = nys, nyn
	1245	DO i = nxl, nxr
[1]	1246	local_2d(i,j) = local_2d(i,j) + local_pf(i,j,k)
	1247	ENDDO
	1248	ENDDO
	1249	ENDDO
	1250
[1551]	1251	local_2d = local_2d / ( nzt_do - nzb_do + 1.0_wp)
[1]	1252
	1253	ELSE
	1254	!
	1255	!-- Just store the respective section on the local array
	1256	local_2d = local_pf(:,:,layer_xy)
	1257
	1258	ENDIF
	1259
	1260	#if defined( __parallel )
[1327]	1261	IF ( netcdf_data_format > 4 ) THEN
[1]	1262	!
[1031]	1263	!-- Parallel output in netCDF4/HDF5 format.
[493]	1264	IF ( two_d ) THEN
	1265	iis = 1
	1266	ELSE
	1267	iis = is
	1268	ENDIF
	1269
[1]	1270	#if defined( __netcdf )
[1308]	1271	!
	1272	!-- For parallel output, all cross sections are first stored
	1273	!-- here on a local array and will be written to the output
	1274	!-- file afterwards to increase the performance.
[2512]	1275	DO i = nxl, nxr
	1276	DO j = nys, nyn
[1308]	1277	local_2d_sections(i,j,iis) = local_2d(i,j)
	1278	ENDDO
	1279	ENDDO
[1]	1280	#endif
[493]	1281	ELSE
[1]	1282
[493]	1283	IF ( data_output_2d_on_each_pe ) THEN
[1]	1284	!
[493]	1285	!-- Output of partial arrays on each PE
	1286	#if defined( __netcdf )
[1327]	1287	IF ( myid == 0 ) THEN
[1320]	1288	WRITE ( 21 ) time_since_reference_point, &
[493]	1289	do2d_xy_time_count(av), av
	1290	ENDIF
	1291	#endif
[759]	1292	DO i = 0, io_blocks-1
	1293	IF ( i == io_group ) THEN
[2512]	1294	WRITE ( 21 ) nxl, nxr, nys, nyn, nys, nyn
[759]	1295	WRITE ( 21 ) local_2d
	1296	ENDIF
	1297	#if defined( __parallel )
	1298	CALL MPI_BARRIER( comm2d, ierr )
	1299	#endif
	1300	ENDDO
[559]	1301
[493]	1302	ELSE
[1]	1303	!
[493]	1304	!-- PE0 receives partial arrays from all processors and
	1305	!-- then outputs them. Here a barrier has to be set,
	1306	!-- because otherwise "-MPI- FATAL: Remote protocol queue
	1307	!-- full" may occur.
	1308	CALL MPI_BARRIER( comm2d, ierr )
	1309
[2512]	1310	ngp = ( nxr-nxl+1 ) * ( nyn-nys+1 )
[493]	1311	IF ( myid == 0 ) THEN
[1]	1312	!
[493]	1313	!-- Local array can be relocated directly.
[2512]	1314	total_2d(nxl:nxr,nys:nyn) = local_2d
[1]	1315	!
[493]	1316	!-- Receive data from all other PEs.
	1317	DO n = 1, numprocs-1
[1]	1318	!
[493]	1319	!-- Receive index limits first, then array.
	1320	!-- Index limits are received in arbitrary order from
	1321	!-- the PEs.
[1320]	1322	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
	1323	MPI_ANY_SOURCE, 0, comm2d, &
[493]	1324	status, ierr )
	1325	sender = status(MPI_SOURCE)
	1326	DEALLOCATE( local_2d )
	1327	ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
[1320]	1328	CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
	1329	MPI_REAL, sender, 1, comm2d, &
[493]	1330	status, ierr )
	1331	total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
	1332	ENDDO
[1]	1333	!
[493]	1334	!-- Relocate the local array for the next loop increment
	1335	DEALLOCATE( local_2d )
[2512]	1336	ALLOCATE( local_2d(nxl:nxr,nys:nyn) )
[1]	1337
	1338	#if defined( __netcdf )
[1327]	1339	IF ( two_d ) THEN
	1340	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
[3554]	1341	id_var_do2d(av,ivar), &
[2512]	1342	total_2d(0:nx,0:ny), &
[1327]	1343	start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
[2512]	1344	count = (/ nx+1, ny+1, 1, 1 /) )
[1327]	1345	ELSE
	1346	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
[3554]	1347	id_var_do2d(av,ivar), &
[2512]	1348	total_2d(0:nx,0:ny), &
[1327]	1349	start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
[2512]	1350	count = (/ nx+1, ny+1, 1, 1 /) )
[1]	1351	ENDIF
[1783]	1352	CALL netcdf_handle_error( 'data_output_2d', 54 )
[1]	1353	#endif
	1354
[493]	1355	ELSE
[1]	1356	!
[493]	1357	!-- First send the local index limits to PE0
[2512]	1358	ind(1) = nxl; ind(2) = nxr
	1359	ind(3) = nys; ind(4) = nyn
[1320]	1360	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
[493]	1361	comm2d, ierr )
[1]	1362	!
[493]	1363	!-- Send data to PE0
[2512]	1364	CALL MPI_SEND( local_2d(nxl,nys), ngp, &
[493]	1365	MPI_REAL, 0, 1, comm2d, ierr )
	1366	ENDIF
	1367	!
	1368	!-- A barrier has to be set, because otherwise some PEs may
	1369	!-- proceed too fast so that PE0 may receive wrong data on
	1370	!-- tag 0
	1371	CALL MPI_BARRIER( comm2d, ierr )
[1]	1372	ENDIF
[493]	1373
[1]	1374	ENDIF
	1375	#else
	1376	#if defined( __netcdf )
[1327]	1377	IF ( two_d ) THEN
	1378	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
[3554]	1379	id_var_do2d(av,ivar), &
[2512]	1380	local_2d(nxl:nxr,nys:nyn), &
[1327]	1381	start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
[2512]	1382	count = (/ nx+1, ny+1, 1, 1 /) )
[1327]	1383	ELSE
	1384	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
[3554]	1385	id_var_do2d(av,ivar), &
[2512]	1386	local_2d(nxl:nxr,nys:nyn), &
[1327]	1387	start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
[2512]	1388	count = (/ nx+1, ny+1, 1, 1 /) )
[1]	1389	ENDIF
[1783]	1390	CALL netcdf_handle_error( 'data_output_2d', 447 )
[1]	1391	#endif
	1392	#endif
[2277]	1393
[1]	1394	!
	1395	!-- For 2D-arrays (e.g. u*) only one cross-section is available.
	1396	!-- Hence exit loop of output levels.
	1397	IF ( two_d ) THEN
[1703]	1398	IF ( netcdf_data_format < 5 ) two_d = .FALSE.
[1]	1399	EXIT loop1
	1400	ENDIF
	1401
	1402	CASE ( 'xz' )
	1403	!
[1308]	1404	!-- Update the netCDF xz cross section time axis.
	1405	!-- In case of parallel output, this is only done by PE0
	1406	!-- to increase the performance.
[3646]	1407	IF ( time_since_reference_point /= do2d_xz_last_time(av) ) THEN
[1308]	1408	do2d_xz_time_count(av) = do2d_xz_time_count(av) + 1
[3646]	1409	do2d_xz_last_time(av) = time_since_reference_point
[1308]	1410	IF ( myid == 0 ) THEN
[1327]	1411	IF ( .NOT. data_output_2d_on_each_pe &
	1412	.OR. netcdf_data_format > 4 ) &
[493]	1413	THEN
[1]	1414	#if defined( __netcdf )
	1415	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
	1416	id_var_time_xz(av), &
[291]	1417	(/ time_since_reference_point /), &
[1]	1418	start = (/ do2d_xz_time_count(av) /), &
	1419	count = (/ 1 /) )
[1783]	1420	CALL netcdf_handle_error( 'data_output_2d', 56 )
[1]	1421	#endif
	1422	ENDIF
	1423	ENDIF
	1424	ENDIF
[667]	1425
[1]	1426	!
	1427	!-- If required, carry out averaging along y
[1960]	1428	IF ( section(is,s_ind) == -1 ) THEN
[1]	1429
[2512]	1430	ALLOCATE( local_2d_l(nxl:nxr,nzb_do:nzt_do) )
[1353]	1431	local_2d_l = 0.0_wp
[2512]	1432	ngp = ( nxr-nxl + 1 ) * ( nzt_do-nzb_do + 1 )
[1]	1433	!
	1434	!-- First local averaging on the PE
[1551]	1435	DO k = nzb_do, nzt_do
[1]	1436	DO j = nys, nyn
[2512]	1437	DO i = nxl, nxr
[1320]	1438	local_2d_l(i,k) = local_2d_l(i,k) + &
[1]	1439	local_pf(i,j,k)
	1440	ENDDO
	1441	ENDDO
	1442	ENDDO
	1443	#if defined( __parallel )
	1444	!
	1445	!-- Now do the averaging over all PEs along y
[622]	1446	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
[2512]	1447	CALL MPI_ALLREDUCE( local_2d_l(nxl,nzb_do), &
	1448	local_2d(nxl,nzb_do), ngp, MPI_REAL, &
[1]	1449	MPI_SUM, comm1dy, ierr )
	1450	#else
	1451	local_2d = local_2d_l
	1452	#endif
[1353]	1453	local_2d = local_2d / ( ny + 1.0_wp )
[1]	1454
	1455	DEALLOCATE( local_2d_l )
	1456
	1457	ELSE
	1458	!
	1459	!-- Just store the respective section on the local array
	1460	!-- (but only if it is available on this PE!)
[1960]	1461	IF ( section(is,s_ind) >= nys .AND. section(is,s_ind) <= nyn ) &
[1]	1462	THEN
[1960]	1463	local_2d = local_pf(:,section(is,s_ind),nzb_do:nzt_do)
[1]	1464	ENDIF
	1465
	1466	ENDIF
	1467
	1468	#if defined( __parallel )
[1327]	1469	IF ( netcdf_data_format > 4 ) THEN
[1]	1470	!
[1031]	1471	!-- Output in netCDF4/HDF5 format.
[493]	1472	!-- Output only on those PEs where the respective cross
	1473	!-- sections reside. Cross sections averaged along y are
	1474	!-- output on the respective first PE along y (myidy=0).
[1960]	1475	IF ( ( section(is,s_ind) >= nys .AND. &
	1476	section(is,s_ind) <= nyn ) .OR. &
	1477	( section(is,s_ind) == -1 .AND. myidy == 0 ) ) THEN
[1]	1478	#if defined( __netcdf )
[493]	1479	!
[1308]	1480	!-- For parallel output, all cross sections are first
	1481	!-- stored here on a local array and will be written to the
	1482	!-- output file afterwards to increase the performance.
[2512]	1483	DO i = nxl, nxr
[1551]	1484	DO k = nzb_do, nzt_do
[1308]	1485	local_2d_sections_l(i,is,k) = local_2d(i,k)
	1486	ENDDO
	1487	ENDDO
[1]	1488	#endif
	1489	ENDIF
	1490
	1491	ELSE
	1492
[493]	1493	IF ( data_output_2d_on_each_pe ) THEN
[1]	1494	!
[493]	1495	!-- Output of partial arrays on each PE. If the cross
	1496	!-- section does not reside on the PE, output special
	1497	!-- index values.
	1498	#if defined( __netcdf )
[1327]	1499	IF ( myid == 0 ) THEN
[1320]	1500	WRITE ( 22 ) time_since_reference_point, &
[493]	1501	do2d_xz_time_count(av), av
	1502	ENDIF
	1503	#endif
[759]	1504	DO i = 0, io_blocks-1
	1505	IF ( i == io_group ) THEN
[1960]	1506	IF ( ( section(is,s_ind) >= nys .AND. &
	1507	section(is,s_ind) <= nyn ) .OR. &
	1508	( section(is,s_ind) == -1 .AND. &
[1320]	1509	nys-1 == -1 ) ) &
[759]	1510	THEN
[2512]	1511	WRITE (22) nxl, nxr, nzb_do, nzt_do, nzb, nzt+1
[759]	1512	WRITE (22) local_2d
	1513	ELSE
[1551]	1514	WRITE (22) -1, -1, -1, -1, -1, -1
[759]	1515	ENDIF
	1516	ENDIF
	1517	#if defined( __parallel )
	1518	CALL MPI_BARRIER( comm2d, ierr )
	1519	#endif
	1520	ENDDO
[493]	1521
	1522	ELSE
[1]	1523	!
[493]	1524	!-- PE0 receives partial arrays from all processors of the
	1525	!-- respective cross section and outputs them. Here a
	1526	!-- barrier has to be set, because otherwise
	1527	!-- "-MPI- FATAL: Remote protocol queue full" may occur.
	1528	CALL MPI_BARRIER( comm2d, ierr )
	1529
[2512]	1530	ngp = ( nxr-nxl + 1 ) * ( nzt_do-nzb_do + 1 )
[493]	1531	IF ( myid == 0 ) THEN
[1]	1532	!
[493]	1533	!-- Local array can be relocated directly.
[1960]	1534	IF ( ( section(is,s_ind) >= nys .AND. &
	1535	section(is,s_ind) <= nyn ) .OR. &
	1536	( section(is,s_ind) == -1 .AND. &
	1537	nys-1 == -1 ) ) THEN
[2512]	1538	total_2d(nxl:nxr,nzb_do:nzt_do) = local_2d
[493]	1539	ENDIF
[1]	1540	!
[493]	1541	!-- Receive data from all other PEs.
	1542	DO n = 1, numprocs-1
	1543	!
	1544	!-- Receive index limits first, then array.
	1545	!-- Index limits are received in arbitrary order from
	1546	!-- the PEs.
[1320]	1547	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
	1548	MPI_ANY_SOURCE, 0, comm2d, &
[1]	1549	status, ierr )
[493]	1550	!
	1551	!-- Not all PEs have data for XZ-cross-section.
	1552	IF ( ind(1) /= -9999 ) THEN
	1553	sender = status(MPI_SOURCE)
	1554	DEALLOCATE( local_2d )
[1320]	1555	ALLOCATE( local_2d(ind(1):ind(2), &
[493]	1556	ind(3):ind(4)) )
	1557	CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
	1558	MPI_REAL, sender, 1, comm2d, &
	1559	status, ierr )
[1320]	1560	total_2d(ind(1):ind(2),ind(3):ind(4)) = &
[493]	1561	local_2d
	1562	ENDIF
	1563	ENDDO
	1564	!
	1565	!-- Relocate the local array for the next loop increment
	1566	DEALLOCATE( local_2d )
[2512]	1567	ALLOCATE( local_2d(nxl:nxr,nzb_do:nzt_do) )
[1]	1568
	1569	#if defined( __netcdf )
[2512]	1570	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
[3554]	1571	id_var_do2d(av,ivar), &
[2512]	1572	total_2d(0:nx,nzb_do:nzt_do), &
	1573	start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
	1574	count = (/ nx+1, 1, nzt_do-nzb_do+1, 1 /) )
[1783]	1575	CALL netcdf_handle_error( 'data_output_2d', 58 )
[1]	1576	#endif
	1577
[493]	1578	ELSE
[1]	1579	!
[493]	1580	!-- If the cross section resides on the PE, send the
	1581	!-- local index limits, otherwise send -9999 to PE0.
[1960]	1582	IF ( ( section(is,s_ind) >= nys .AND. &
	1583	section(is,s_ind) <= nyn ) .OR. &
	1584	( section(is,s_ind) == -1 .AND. nys-1 == -1 ) ) &
[493]	1585	THEN
[2512]	1586	ind(1) = nxl; ind(2) = nxr
[1551]	1587	ind(3) = nzb_do; ind(4) = nzt_do
[493]	1588	ELSE
	1589	ind(1) = -9999; ind(2) = -9999
	1590	ind(3) = -9999; ind(4) = -9999
	1591	ENDIF
[1320]	1592	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
[493]	1593	comm2d, ierr )
	1594	!
	1595	!-- If applicable, send data to PE0.
	1596	IF ( ind(1) /= -9999 ) THEN
[2512]	1597	CALL MPI_SEND( local_2d(nxl,nzb_do), ngp, &
[493]	1598	MPI_REAL, 0, 1, comm2d, ierr )
	1599	ENDIF
[1]	1600	ENDIF
	1601	!
[493]	1602	!-- A barrier has to be set, because otherwise some PEs may
	1603	!-- proceed too fast so that PE0 may receive wrong data on
	1604	!-- tag 0
	1605	CALL MPI_BARRIER( comm2d, ierr )
[1]	1606	ENDIF
[493]	1607
[1]	1608	ENDIF
	1609	#else
	1610	#if defined( __netcdf )
[1327]	1611	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
[3554]	1612	id_var_do2d(av,ivar), &
[2512]	1613	local_2d(nxl:nxr,nzb_do:nzt_do), &
[1327]	1614	start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
[2512]	1615	count = (/ nx+1, 1, nzt_do-nzb_do+1, 1 /) )
[1783]	1616	CALL netcdf_handle_error( 'data_output_2d', 451 )
[1]	1617	#endif
	1618	#endif
	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.
[3646]	1625	IF ( time_since_reference_point /= do2d_yz_last_time(av) ) THEN
[1308]	1626	do2d_yz_time_count(av) = do2d_yz_time_count(av) + 1
[3646]	1627	do2d_yz_last_time(av) = time_since_reference_point
[1308]	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 /) )
[1783]	1638	CALL netcdf_handle_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
[1960]	1646	IF ( section(is,s_ind) == -1 ) THEN
[1]	1647
[2512]	1648	ALLOCATE( local_2d_l(nys:nyn,nzb_do:nzt_do) )
[1353]	1649	local_2d_l = 0.0_wp
[2512]	1650	ngp = ( nyn-nys+1 ) * ( nzt_do-nzb_do+1 )
[1]	1651	!
	1652	!-- First local averaging on the PE
[1551]	1653	DO k = nzb_do, nzt_do
[2512]	1654	DO j = nys, nyn
[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 )
[2512]	1665	CALL MPI_ALLREDUCE( local_2d_l(nys,nzb_do), &
	1666	local_2d(nys,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!)
[1960]	1679	IF ( section(is,s_ind) >= nxl .AND. section(is,s_ind) <= nxr ) &
[1]	1680	THEN
[1960]	1681	local_2d = local_pf(section(is,s_ind),:,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).
[1960]	1693	IF ( ( section(is,s_ind) >= nxl .AND. &
	1694	section(is,s_ind) <= nxr ) .OR. &
	1695	( section(is,s_ind) == -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.
[2512]	1701	DO j = nys, nyn
[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
[1960]	1724	IF ( ( section(is,s_ind) >= nxl .AND. &
	1725	section(is,s_ind) <= nxr ) .OR. &
	1726	( section(is,s_ind) == -1 .AND. &
[1320]	1727	nxl-1 == -1 ) ) &
[759]	1728	THEN
[2512]	1729	WRITE (23) nys, nyn, 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
[2512]	1748	ngp = ( nyn-nys+1 ) * ( nzt_do-nzb_do+1 )
[493]	1749	IF ( myid == 0 ) THEN
[1]	1750	!
[493]	1751	!-- Local array can be relocated directly.
[1960]	1752	IF ( ( section(is,s_ind) >= nxl .AND. &
	1753	section(is,s_ind) <= nxr ) .OR. &
	1754	( section(is,s_ind) == -1 .AND. nxl-1 == -1 ) ) &
[493]	1755	THEN
[2512]	1756	total_2d(nys:nyn,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 )
[2512]	1785	ALLOCATE( local_2d(nys:nyn,nzb_do:nzt_do) )
[1]	1786
	1787	#if defined( __netcdf )
[2512]	1788	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
[3554]	1789	id_var_do2d(av,ivar), &
[2512]	1790	total_2d(0:ny,nzb_do:nzt_do), &
	1791	start = (/ is, 1, 1, do2d_yz_time_count(av) /), &
	1792	count = (/ 1, ny+1, nzt_do-nzb_do+1, 1 /) )
[1783]	1793	CALL netcdf_handle_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.
[1960]	1800	IF ( ( section(is,s_ind) >= nxl .AND. &
	1801	section(is,s_ind) <= nxr ) .OR. &
	1802	( section(is,s_ind) == -1 .AND. nxl-1 == -1 ) ) &
[493]	1803	THEN
[2512]	1804	ind(1) = nys; ind(2) = nyn
[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
[2512]	1815	CALL MPI_SEND( local_2d(nys,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), &
[3554]	1830	id_var_do2d(av,ivar), &
[2512]	1831	local_2d(nys:nyn,nzb_do:nzt_do), &
[1327]	1832	start = (/ is, 1, 1, do2d_xz_time_count(av) /), &
[2512]	1833	count = (/ 1, ny+1, nzt_do-nzb_do+1, 1 /) )
[1783]	1834	CALL netcdf_handle_error( 'data_output_2d', 452 )
[1]	1835	#endif
	1836	#endif
	1837
	1838	END SELECT
	1839
	1840	is = is + 1
	1841	ENDDO loop1
	1842
[1308]	1843	!
	1844	!-- For parallel output, all data were collected before on a local array
	1845	!-- and are written now to the netcdf file. This must be done to increase
	1846	!-- the performance of the parallel output.
	1847	#if defined( __netcdf )
[1327]	1848	IF ( netcdf_data_format > 4 ) THEN
[1308]	1849
	1850	SELECT CASE ( mode )
	1851
	1852	CASE ( 'xy' )
	1853	IF ( two_d ) THEN
[1703]	1854	nis = 1
	1855	two_d = .FALSE.
[1308]	1856	ELSE
[1703]	1857	nis = ns
[1308]	1858	ENDIF
	1859	!
	1860	!-- Do not output redundant ghost point data except for the
	1861	!-- boundaries of the total domain.
[2512]	1862	! IF ( nxr == nx .AND. nyn /= ny ) THEN
	1863	! nc_stat = NF90_PUT_VAR( id_set_xy(av), &
[3554]	1864	! id_var_do2d(av,ivar), &
[2512]	1865	! local_2d_sections(nxl:nxr+1, &
	1866	! nys:nyn,1:nis), &
	1867	! start = (/ nxl+1, nys+1, 1, &
	1868	! do2d_xy_time_count(av) /), &
	1869	! count = (/ nxr-nxl+2, &
	1870	! nyn-nys+1, nis, 1 &
	1871	! /) )
	1872	! ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN
	1873	! nc_stat = NF90_PUT_VAR( id_set_xy(av), &
[3554]	1874	! id_var_do2d(av,ivar), &
[2512]	1875	! local_2d_sections(nxl:nxr, &
	1876	! nys:nyn+1,1:nis), &
	1877	! start = (/ nxl+1, nys+1, 1, &
	1878	! do2d_xy_time_count(av) /), &
	1879	! count = (/ nxr-nxl+1, &
	1880	! nyn-nys+2, nis, 1 &
	1881	! /) )
	1882	! ELSEIF ( nxr == nx .AND. nyn == ny ) THEN
	1883	! nc_stat = NF90_PUT_VAR( id_set_xy(av), &
[3554]	1884	! id_var_do2d(av,ivar), &
[2512]	1885	! local_2d_sections(nxl:nxr+1, &
	1886	! nys:nyn+1,1:nis), &
	1887	! start = (/ nxl+1, nys+1, 1, &
	1888	! do2d_xy_time_count(av) /), &
	1889	! count = (/ nxr-nxl+2, &
	1890	! nyn-nys+2, nis, 1 &
	1891	! /) )
	1892	! ELSE
[1308]	1893	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
[3554]	1894	id_var_do2d(av,ivar), &
[1308]	1895	local_2d_sections(nxl:nxr, &
[1703]	1896	nys:nyn,1:nis), &
[1308]	1897	start = (/ nxl+1, nys+1, 1, &
	1898	do2d_xy_time_count(av) /), &
	1899	count = (/ nxr-nxl+1, &
[1703]	1900	nyn-nys+1, nis, 1 &
[1308]	1901	/) )
[2512]	1902	! ENDIF
[1308]	1903
[1783]	1904	CALL netcdf_handle_error( 'data_output_2d', 55 )
[1308]	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
[2512]	1921	ngp = ( nxr-nxl+1 ) * ( nzt_do-nzb_do+1 ) * ns
[1308]	1922	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
[2512]	1923	CALL MPI_ALLREDUCE( local_2d_sections_l(nxl,1,nzb_do), &
	1924	local_2d_sections(nxl,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.
[2512]	1934	! IF ( nxr == nx ) THEN
	1935	! nc_stat = NF90_PUT_VAR( id_set_xz(av), &
[3554]	1936	! id_var_do2d(av,ivar), &
[2512]	1937	! local_2d_sections(nxl:nxr+1,1:ns, &
	1938	! nzb_do:nzt_do), &
	1939	! start = (/ nxl+1, 1, 1, &
	1940	! do2d_xz_time_count(av) /), &
	1941	! count = (/ nxr-nxl+2, ns, nzt_do-nzb_do+1, &
	1942	! 1 /) )
	1943	! ELSE
[1308]	1944	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
[3554]	1945	id_var_do2d(av,ivar), &
[1308]	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 /) )
[2512]	1952	! ENDIF
[1308]	1953
[1783]	1954	CALL netcdf_handle_error( 'data_output_2d', 57 )
[1308]	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
[2512]	1971	ngp = ( nyn-nys+1 ) * ( nzt-nzb + 2 ) * ns
[1308]	1972	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
[2512]	1973	CALL MPI_ALLREDUCE( local_2d_sections_l(1,nys,nzb_do), &
	1974	local_2d_sections(1,nys,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.
[2512]	1984	! IF ( nyn == ny ) THEN
	1985	! nc_stat = NF90_PUT_VAR( id_set_yz(av), &
[3554]	1986	! id_var_do2d(av,ivar), &
[2512]	1987	! local_2d_sections(1:ns, &
	1988	! nys:nyn+1,nzb_do:nzt_do), &
	1989	! start = (/ 1, nys+1, 1, &
	1990	! do2d_yz_time_count(av) /), &
	1991	! count = (/ ns, nyn-nys+2, &
	1992	! nzt_do-nzb_do+1, 1 /) )
	1993	! ELSE
[1308]	1994	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
[3554]	1995	id_var_do2d(av,ivar), &
[1308]	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 /) )
[2512]	2002	! ENDIF
[1308]	2003
[1783]	2004	CALL netcdf_handle_error( 'data_output_2d', 60 )
[1308]	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
[3554]	2016	ivar = ivar + 1
	2017	l = MAX( 2, LEN_TRIM( do2d(av,ivar) ) )
	2018	do2d_mode = do2d(av,ivar)(l-1:l)
[1]	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.
[1960]	2037	file_id = 20 + s_ind
[1]	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
[3987]	2054	IF ( debug_output_timestep ) CALL debug_message( 'data_output_2d', 'end' )
[3885]	2055
[3987]	2056
[1]	2057	END SUBROUTINE data_output_2d

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |