Home

Context Navigation

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

Last change on this file since 1028 was 1008, checked in by franke, 12 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 67.5 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |