Home

Context Navigation

data_output_2d.f90 @ 403

Last change on this file since 403 was 392, checked in by raasch, 15 years ago

New:
---

Adapted for machine lck
(mrun, mbuild, subjob)

bc_lr/bc_ns in most subroutines replaced by LOGICAL variables bc_lr_cyc,
bc_ns_cyc for speed optimization
(check_parameters, diffusion_u, diffusion_v, diffusion_w, modules)

Additional timestep criterion in case of simulations with plant canopy (timestep)

Check for illegal entries in section_xy|xz|yz that exceed nz+1|ny+1|nx+1
(check_parameters)

Clipping of dvrp output implemented. Default colourtable for particles
implemented, particle attributes (color, dvrp_size) can be set with new
parameters particle_color, particle_dvrpsize, color_interval,
dvrpsize_interval (init_dvrp, data_output_dvrp, modules, user_data_output_dvrp).
Slicer attributes (dvrp) are set with new routine set_slicer_attributes_dvrp
and are controlled with existing parameters slicer_range_limits.
(set_slicer_attributes_dvrp)

Ocean atmosphere coupling allows to use independent precursor runs in order
to account for different spin-up times. The time when coupling has to be
started is given by new inipar parameter coupling_start_time. The precursor
ocean run has to be started using new mrun option "-y" in order to add
appendix "_O" to all output files.
(check_for_restart, check_parameters, data_output_2d, data_output_3d,
data_output_profiles, data_output_ptseries, data_output_spectra,
data_output_tseries, header, init_coupling, modules, mrun,
parin, read_var_list, surface_coupler, time_integration, write_var_list)

Polygon reduction for topography and ground plate isosurface. Reduction level
for buildings can be chosen with parameter cluster_size. (init_dvrp)

External pressure gradient (check_parameters, header, init_3d_model, modules,
parin, prognostic_equations, read_var_list, write_var_list)

New topography case 'single_street_canyon' (header, init_grid, modules, parin,
read_var_list, user_check_parameters, user_header, user_init_grid, write_var_list)

Option to predefine a target bulk velocity for conserve_volume_flow
(check_parameters, header, init_3d_model, modules, parin, read_var_list,
write_var_list)

Option for user defined 2D data output in xy cross sections at z=nzb+1
(data_output_2d, user_data_output_2d)

xy cross section output of surface heatfluxes (latent, sensible)
(average_3d_data, check_parameters, data_output_2d, modules, read_3d_binary,
sum_up_3d_data, write_3d_binary)

average_3d_data, check_for_restart, check_parameters, data_output_2d, data_output_3d, data_output_dvrp, data_output_profiles, data_output_ptseries, data_output_spectra, data_output_tseries, init_coupling, init_dvrp, init_grid, init_3d_model, header, mbuild, modules, mrun, package_parin, parin, prognostic_equations, read_3d_binary, read_var_list, subjob, surface_coupler, timestep, time_integration, user_check_parameters, user_data_output_2d, user_data_output_dvrp, user_header, user_init_grid, write_3d_binary, write_var_list

New: set_particle_attributes, set_slicer_attributes_dvrp

Changed:

lcmuk changed to lc to avoid problems with Intel compiler on sgi-ice
(poisfft)

For extended NetCDF files, the updated title attribute includes an update of
time_average_text where appropriate. (netcdf)

In case of restart runs without extension, initial profiles are not written
to NetCDF-file anymore. (data_output_profiles, modules, read_var_list, write_var_list)

Small change in formatting of the message handling routine concering the output in the
job protocoll. (message)

initializing_actions='read_data_for_recycling' renamed to 'cyclic_fill', now
independent of turbulent_inflow (check_parameters, header, init_3d_model)

2 NetCDF error numbers changed. (data_output_3d)

A Link to the website appendix_a.html is printed for further information
about the possible errors. (message)

Temperature gradient criterion for estimating the boundary layer height
replaced by the gradient criterion of Sullivan et al. (1998). (flow_statistics)

NetCDF unit attribute in timeseries output in case of statistic regions added
(netcdf)

Output of NetCDF messages with aid of message handling routine.
(check_open, close_file, data_output_2d, data_output_3d,
data_output_profiles, data_output_ptseries, data_output_spectra,
data_output_tseries, netcdf, output_particles_netcdf)

Output of messages replaced by message handling routine.
(advec_particles, advec_s_bc, buoyancy, calc_spectra, check_for_restart,
check_open, coriolis, cpu_log, data_output_2d, data_output_3d, data_output_dvrp,
data_output_profiles, data_output_spectra, fft_xy, flow_statistics, header,
init_1d_model, init_3d_model, init_dvrp, init_grid, init_particles, init_pegrid,
netcdf, parin, plant_canopy_model, poisfft_hybrid, poismg, read_3d_binary,
read_var_list, surface_coupler, temperton_fft, timestep, user_actions,
user_data_output_dvrp, user_dvrp_coltab, user_init_grid, user_init_plant_canopy,
user_parin, user_read_restart_data, user_spectra )

Maximum number of tails is calculated from maximum number of particles and
skip_particles_for_tail (init_particles)

Value of vertical_particle_advection may differ for each particle group
(advec_particles, header, modules)

First constant in array den also defined as type double. (eqn_state_seawater)

Parameter dvrp_psize moved from particles_par to dvrp_graphics_par. (package_parin)

topography_grid_convention moved from userpar to inipar (check_parameters,
header, parin, read_var_list, user_check_parameters, user_header,
user_init_grid, user_parin, write_var_list)

Default value of grid_matching changed to strict.

Adjustments for runs on lcxt4 (necessary due to an software update on CRAY) and
for coupled runs on ibmy (mrun, subjob)

advec_particles, advec_s_bc, buoyancy, calc_spectra, check_for_restart, check_open, check_parameters, close_file, coriolis, cpu_log, data_output_2d, data_output_3d, data_output_dvrp, data_output_profiles, data_output_ptseries, data_output_spectra, data_output_tseries, eqn_state_seawater, fft_xy, flow_statistics, header, init_1d_model, init_3d_model, init_dvrp, init_grid, init_particles, init_pegrid, message, mrun, netcdf, output_particles_netcdf, package_parin, parin, plant_canopy_model, poisfft, poisfft_hybrid, poismg, read_3d_binary, read_var_list, sort_particles, subjob, user_check_parameters, user_header, user_init_grid, user_parin, surface_coupler, temperton_fft, timestep, user_actions, user_data_output_dvrp, user_dvrp_coltab, user_init_grid, user_init_plant_canopy, user_parin, user_read_restart_data, user_spectra, write_var_list

Errors:

Bugfix: Initial hydrostatic pressure profile in case of ocean runs is now
calculated in 5 iteration steps. (init_ocean)

Bugfix: wrong sign in buoyancy production of ocean part in case of not using
the reference density (only in 3D routine production_e) (production_e)

Bugfix: output of averaged 2d/3d quantities requires that an avaraging
interval has been set, respective error message is included (check_parameters)

Bugfix: Output on unit 14 only if requested by write_binary.
(user_last_actions)

Bugfix to avoid zero division by km_neutral (production_e)

Bugfix for extended NetCDF files: In order to avoid 'data mode' errors if
updated attributes are larger than their original size, NF90_PUT_ATT is called
in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a
possible performance loss; an alternative strategy would be to ensure equal
attribute size in a job chain. (netcdf)

Bugfix: correction of initial volume flow for non-flat topography (init_3d_model)
Bugfix: zero initialization of arrays within buildings for 'cyclic_fill' (init_3d_model)

Bugfix: to_be_resorted => s_av for time-averaged scalars (data_output_2d, data_output_3d)

Bugfix: error in formatting the output (message)

Bugfix: avoid that ngp_2dh_s_inner becomes zero (init_3_model)

Typographical error: unit of wpt in dots_unit (modules)

Bugfix: error in check, if particles moved further than one subdomain length.
This check must not be applied for newly released particles. (advec_particles)

Bugfix: several tail counters are initialized, particle_tail_coordinates is
only written to file if its third index is > 0, arrays for tails are allocated
with a minimum size of 10 tails if there is no tail initially (init_particles,
advec_particles)

Bugfix: pressure included for profile output (check_parameters)

Bugfix: Type of count and count_rate changed to default INTEGER on NEC machines
(cpu_log)

Bugfix: output if particle time series only if particle advection is switched
on. (time_integration)

Bugfix: qsws was calculated in case of constant heatflux = .FALSE. (prandtl_fluxes)

Bugfix: averaging along z is not allowed for 2d quantities (e.g. u* and z0) (data_output_2d)

Typographical errors (netcdf)

If the inversion height calculated by the prerun is zero, inflow_damping_height
must be explicitly specified (init_3d_model)

Small bugfix concerning 3d 64bit netcdf output format (header)

Bugfix: dt_fixed removed from the restart file, because otherwise, no change
from a fixed to a variable timestep would be possible in restart runs.
(read_var_list, write_var_list)

Bugfix: initial setting of time_coupling in coupled restart runs (time_integration)

advec_particles, check_parameters, cpu_log, data_output_2d, data_output_3d, header, init_3d_model, init_particles, init_ocean, modules, netcdf, prandtl_fluxes, production_e, read_var_list, time_integration, user_last_actions, write_var_list

Property svn:keywords set to Id

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

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

Context Navigation

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

Download in other formats: