Home

Context Navigation

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

Last change on this file since 582 was 559, checked in by weinreis, 14 years ago

Property svn:keywords set to `Id`
File size: 62.9 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |