Home

Context Navigation

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

Last change on this file since 992 was 979, checked in by fricke, 12 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 66.3 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |