Home

Context Navigation

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

Last change on this file since 729 was 729, checked in by heinze, 14 years ago
Exchange ghost layers for p regardless of used pressure solver (except SOR)
Property svn:keywords set to `Id`
File size: 63.9 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |