Home

Context Navigation

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

Last change on this file since 796 was 791, checked in by raasch, 13 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 65.7 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |