Home

Context Navigation

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

Last change on this file since 684 was 674, checked in by suehring, 14 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 63.7 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |