Home

Context Navigation

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

Last change on this file since 4326 was 4182, checked in by scharf, 5 years ago
corrected "Former revisions" section minor formatting in "Former revisions" section added "Author" section
Property svn:keywords set to `Id`
File size: 89.5 KB

Line
1	!> @file data_output_2d.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2019 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! ------------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: data_output_2d.f90 4182 2019-08-22 15:20:23Z oliver.maas $
27	! Corrected "Former revisions" section
28	!
29	! 4048 2019-06-21 21:00:21Z knoop
30	! Removed turbulence_closure_mod dependency
31	!
32	! 4039 2019-06-18 10:32:41Z suehring
33	! modularize diagnostic output
34	!
35	! 3994 2019-05-22 18:08:09Z suehring
36	! output of turbulence intensity added
37	!
38	! 3987 2019-05-22 09:52:13Z kanani
39	! Introduce alternative switch for debug output during timestepping
40	!
41	! 3943 2019-05-02 09:50:41Z maronga
42	! Added output of qsws for green roofs.
43	!
44	! 3885 2019-04-11 11:29:34Z kanani
45	! Changes related to global restructuring of location messages and introduction
46	! of additional debug messages
47	!
48	! 3766 2019-02-26 16:23:41Z raasch
49	! unused variables removed
50	!
51	! 3655 2019-01-07 16:51:22Z knoop
52	! Bugfix: use time_since_reference_point instead of simulated_time (relevant
53	! when using wall/soil spinup)
54	!
55	! Revision 1.1 1997/08/11 06:24:09 raasch
56	! Initial revision
57	!
58	!
59	! Description:
60	! ------------
61	!> Data output of cross-sections in netCDF format or binary format
62	!> to be later converted to NetCDF by helper routine combine_plot_fields.
63	!> Attention: The position of the sectional planes is still not always computed
64	!> --------- correctly. (zu is used always)!
65	!------------------------------------------------------------------------------!
66	SUBROUTINE data_output_2d( mode, av )
67
68
69	USE arrays_3d, &
70	ONLY: dzw, d_exner, e, heatflux_output_conversion, p, pt, q, ql, ql_c, ql_v, s, tend, u, &
71	v, vpt, w, waterflux_output_conversion, zu, zw
72
73	USE averaging
74
75	USE basic_constants_and_equations_mod, &
76	ONLY: c_p, lv_d_cp, l_v
77
78	USE bulk_cloud_model_mod, &
79	ONLY: bulk_cloud_model
80
81	USE control_parameters, &
82	ONLY: data_output_2d_on_each_pe, &
83	data_output_xy, data_output_xz, data_output_yz, &
84	debug_output_timestep, &
85	do2d, &
86	do2d_xy_last_time, do2d_xy_time_count, &
87	do2d_xz_last_time, do2d_xz_time_count, &
88	do2d_yz_last_time, do2d_yz_time_count, &
89	ibc_uv_b, io_blocks, io_group, message_string, &
90	ntdim_2d_xy, ntdim_2d_xz, ntdim_2d_yz, &
91	psolver, section, &
92	time_since_reference_point
93
94	USE cpulog, &
95	ONLY: cpu_log, log_point
96
97	USE indices, &
98	ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, &
99	nzb, nzt, wall_flags_0
100
101	USE kinds
102
103	USE land_surface_model_mod, &
104	ONLY: zs
105
106	USE module_interface, &
107	ONLY: module_interface_data_output_2d
108
109	#if defined( __netcdf )
110	USE NETCDF
111	#endif
112
113	USE netcdf_interface, &
114	ONLY: fill_value, id_set_xy, id_set_xz, id_set_yz, id_var_do2d, &
115	id_var_time_xy, id_var_time_xz, id_var_time_yz, nc_stat, &
116	netcdf_data_format, netcdf_handle_error
117
118	USE particle_attributes, &
119	ONLY: grid_particles, number_of_particles, particle_advection_start, &
120	particles, prt_count
121
122	USE pegrid
123
124	USE surface_mod, &
125	ONLY: ind_pav_green, ind_veg_wall, ind_wat_win, surf_def_h, &
126	surf_lsm_h, surf_usm_h
127
128
129	IMPLICIT NONE
130
131	CHARACTER (LEN=2) :: do2d_mode !< output mode of variable ('xy', 'xz', 'yz')
132	CHARACTER (LEN=2) :: mode !< mode with which the routine is called ('xy', 'xz', 'yz')
133	CHARACTER (LEN=4) :: grid !< string defining the vertical grid
134
135	INTEGER(iwp) :: av !< flag for (non-)average output
136	INTEGER(iwp) :: ngp !< number of grid points of an output slice
137	INTEGER(iwp) :: file_id !< id of output files
138	INTEGER(iwp) :: flag_nr !< number of masking flag
139	INTEGER(iwp) :: i !< loop index
140	INTEGER(iwp) :: iis !< vertical index of a xy slice in array 'local_2d_sections'
141	INTEGER(iwp) :: is !< slice index
142	INTEGER(iwp) :: ivar !< variable index
143	INTEGER(iwp) :: j !< loop index
144	INTEGER(iwp) :: k !< loop index
145	INTEGER(iwp) :: l !< loop index
146	INTEGER(iwp) :: layer_xy !< vertical index of a xy slice in array 'local_pf'
147	INTEGER(iwp) :: m !< loop index
148	INTEGER(iwp) :: n !< loop index
149	INTEGER(iwp) :: nis !< number of vertical slices to be written via parallel NetCDF output
150	INTEGER(iwp) :: ns !< number of output slices
151	INTEGER(iwp) :: nzb_do !< lower limit of the data field (usually nzb)
152	INTEGER(iwp) :: nzt_do !< upper limit of the data field (usually nzt+1)
153	INTEGER(iwp) :: s_ind !< index of slice types (xy=1, xz=2, yz=3)
154	INTEGER(iwp) :: sender !< PE id of sending PE
155	INTEGER(iwp) :: ind(4) !< index limits (lower/upper bounds) of array 'local_2d'
156
157	LOGICAL :: found !< true if output variable was found
158	LOGICAL :: resorted !< true if variable is resorted
159	LOGICAL :: two_d !< true if variable is only two dimensional
160
161	REAL(wp) :: mean_r !< mean particle radius
162	REAL(wp) :: s_r2 !< sum( particle-radius**2 )
163	REAL(wp) :: s_r3 !< sum( particle-radius**3 )
164
165	REAL(wp), DIMENSION(:), ALLOCATABLE :: level_z !< z levels for output array
166	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: local_2d !< local 2-dimensional array containing output values
167	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: local_2d_l !< local 2-dimensional array containing output values
168
169	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !< output array
170	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_2d_sections !< local array containing values at all slices
171	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_2d_sections_l !< local array containing values at all slices
172
173	#if defined( __parallel )
174	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: total_2d !< same as local_2d
175	#endif
176	REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which shall be output
177
178
179	IF ( debug_output_timestep ) CALL debug_message( 'data_output_2d', 'start' )
180	!
181	!-- Immediate return, if no output is requested (no respective sections
182	!-- found in parameter data_output)
183	IF ( mode == 'xy' .AND. .NOT. data_output_xy(av) ) RETURN
184	IF ( mode == 'xz' .AND. .NOT. data_output_xz(av) ) RETURN
185	IF ( mode == 'yz' .AND. .NOT. data_output_yz(av) ) RETURN
186
187	CALL cpu_log (log_point(3),'data_output_2d','start')
188
189	two_d = .FALSE. ! local variable to distinguish between output of pure 2D
190	! arrays and cross-sections of 3D arrays.
191
192	!
193	!-- Depending on the orientation of the cross-section, the respective output
194	!-- files have to be opened.
195	SELECT CASE ( mode )
196
197	CASE ( 'xy' )
198	s_ind = 1
199	ALLOCATE( level_z(nzb:nzt+1), local_2d(nxl:nxr,nys:nyn) )
200
201	IF ( netcdf_data_format > 4 ) THEN
202	ns = 1
203	DO WHILE ( section(ns,s_ind) /= -9999 .AND. ns <= 100 )
204	ns = ns + 1
205	ENDDO
206	ns = ns - 1
207	ALLOCATE( local_2d_sections(nxl:nxr,nys:nyn,1:ns) )
208	local_2d_sections = 0.0_wp
209	ENDIF
210
211	!
212	!-- Parallel netCDF4/HDF5 output is done on all PEs, all other on PE0 only
213	IF ( myid == 0 .OR. netcdf_data_format > 4 ) THEN
214	CALL check_open( 101+av*10 )
215	ENDIF
216	IF ( data_output_2d_on_each_pe .AND. netcdf_data_format < 5 ) THEN
217	CALL check_open( 21 )
218	ELSE
219	IF ( myid == 0 ) THEN
220	#if defined( __parallel )
221	ALLOCATE( total_2d(0:nx,0:ny) )
222	#endif
223	ENDIF
224	ENDIF
225
226	CASE ( 'xz' )
227	s_ind = 2
228	ALLOCATE( local_2d(nxl:nxr,nzb:nzt+1) )
229
230	IF ( netcdf_data_format > 4 ) THEN
231	ns = 1
232	DO WHILE ( section(ns,s_ind) /= -9999 .AND. ns <= 100 )
233	ns = ns + 1
234	ENDDO
235	ns = ns - 1
236	ALLOCATE( local_2d_sections(nxl:nxr,1:ns,nzb:nzt+1) )
237	ALLOCATE( local_2d_sections_l(nxl:nxr,1:ns,nzb:nzt+1) )
238	local_2d_sections = 0.0_wp; local_2d_sections_l = 0.0_wp
239	ENDIF
240
241	!
242	!-- Parallel netCDF4/HDF5 output is done on all PEs, all other on PE0 only
243	IF ( myid == 0 .OR. netcdf_data_format > 4 ) THEN
244	CALL check_open( 102+av*10 )
245	ENDIF
246
247	IF ( data_output_2d_on_each_pe .AND. netcdf_data_format < 5 ) THEN
248	CALL check_open( 22 )
249	ELSE
250	IF ( myid == 0 ) THEN
251	#if defined( __parallel )
252	ALLOCATE( total_2d(0:nx,nzb:nzt+1) )
253	#endif
254	ENDIF
255	ENDIF
256
257	CASE ( 'yz' )
258	s_ind = 3
259	ALLOCATE( local_2d(nys:nyn,nzb:nzt+1) )
260
261	IF ( netcdf_data_format > 4 ) THEN
262	ns = 1
263	DO WHILE ( section(ns,s_ind) /= -9999 .AND. ns <= 100 )
264	ns = ns + 1
265	ENDDO
266	ns = ns - 1
267	ALLOCATE( local_2d_sections(1:ns,nys:nyn,nzb:nzt+1) )
268	ALLOCATE( local_2d_sections_l(1:ns,nys:nyn,nzb:nzt+1) )
269	local_2d_sections = 0.0_wp; local_2d_sections_l = 0.0_wp
270	ENDIF
271
272	!
273	!-- Parallel netCDF4/HDF5 output is done on all PEs, all other on PE0 only
274	IF ( myid == 0 .OR. netcdf_data_format > 4 ) THEN
275	CALL check_open( 103+av*10 )
276	ENDIF
277
278	IF ( data_output_2d_on_each_pe .AND. netcdf_data_format < 5 ) THEN
279	CALL check_open( 23 )
280	ELSE
281	IF ( myid == 0 ) THEN
282	#if defined( __parallel )
283	ALLOCATE( total_2d(0:ny,nzb:nzt+1) )
284	#endif
285	ENDIF
286	ENDIF
287
288	CASE DEFAULT
289	message_string = 'unknown cross-section: ' // TRIM( mode )
290	CALL message( 'data_output_2d', 'PA0180', 1, 2, 0, 6, 0 )
291
292	END SELECT
293
294	!
295	!-- For parallel netcdf output the time axis must be limited. Return, if this
296	!-- limit is exceeded. This could be the case, if the simulated time exceeds
297	!-- the given end time by the length of the given output interval.
298	IF ( netcdf_data_format > 4 ) THEN
299	IF ( mode == 'xy' .AND. do2d_xy_time_count(av) + 1 > &
300	ntdim_2d_xy(av) ) THEN
301	WRITE ( message_string, * ) 'Output of xy cross-sections is not ', &
302	'given at t=', time_since_reference_point, 's because the', &
303	' maximum number of output time levels is exceeded.'
304	CALL message( 'data_output_2d', 'PA0384', 0, 1, 0, 6, 0 )
305	CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
306	RETURN
307	ENDIF
308	IF ( mode == 'xz' .AND. do2d_xz_time_count(av) + 1 > &
309	ntdim_2d_xz(av) ) THEN
310	WRITE ( message_string, * ) 'Output of xz cross-sections is not ', &
311	'given at t=', time_since_reference_point, 's because the', &
312	' maximum number of output time levels is exceeded.'
313	CALL message( 'data_output_2d', 'PA0385', 0, 1, 0, 6, 0 )
314	CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
315	RETURN
316	ENDIF
317	IF ( mode == 'yz' .AND. do2d_yz_time_count(av) + 1 > &
318	ntdim_2d_yz(av) ) THEN
319	WRITE ( message_string, * ) 'Output of yz cross-sections is not ', &
320	'given at t=', time_since_reference_point, 's because the', &
321	' maximum number of output time levels is exceeded.'
322	CALL message( 'data_output_2d', 'PA0386', 0, 1, 0, 6, 0 )
323	CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
324	RETURN
325	ENDIF
326	ENDIF
327
328	!
329	!-- Allocate a temporary array for resorting (kji -> ijk).
330	ALLOCATE( local_pf(nxl:nxr,nys:nyn,nzb:nzt+1) )
331	local_pf = 0.0
332
333	!
334	!-- Loop of all variables to be written.
335	!-- Output dimensions chosen
336	ivar = 1
337	l = MAX( 2, LEN_TRIM( do2d(av,ivar) ) )
338	do2d_mode = do2d(av,ivar)(l-1:l)
339
340	DO WHILE ( do2d(av,ivar)(1:1) /= ' ' )
341
342	IF ( do2d_mode == mode ) THEN
343	!
344	!-- Set flag to steer output of radiation, land-surface, or user-defined
345	!-- quantities
346	found = .FALSE.
347
348	nzb_do = nzb
349	nzt_do = nzt+1
350	!
351	!-- Before each output, set array local_pf to fill value
352	local_pf = fill_value
353	!
354	!-- Set masking flag for topography for not resorted arrays
355	flag_nr = 0
356
357	!
358	!-- Store the array chosen on the temporary array.
359	resorted = .FALSE.
360	SELECT CASE ( TRIM( do2d(av,ivar) ) )
361	CASE ( 'e_xy', 'e_xz', 'e_yz' )
362	IF ( av == 0 ) THEN
363	to_be_resorted => e
364	ELSE
365	IF ( .NOT. ALLOCATED( e_av ) ) THEN
366	ALLOCATE( e_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
367	e_av = REAL( fill_value, KIND = wp )
368	ENDIF
369	to_be_resorted => e_av
370	ENDIF
371	IF ( mode == 'xy' ) level_z = zu
372
373	CASE ( 'thetal_xy', 'thetal_xz', 'thetal_yz' )
374	IF ( av == 0 ) THEN
375	to_be_resorted => pt
376	ELSE
377	IF ( .NOT. ALLOCATED( lpt_av ) ) THEN
378	ALLOCATE( lpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
379	lpt_av = REAL( fill_value, KIND = wp )
380	ENDIF
381	to_be_resorted => lpt_av
382	ENDIF
383	IF ( mode == 'xy' ) level_z = zu
384
385	CASE ( 'lwp*_xy' ) ! 2d-array
386	IF ( av == 0 ) THEN
387	DO i = nxl, nxr
388	DO j = nys, nyn
389	local_pf(i,j,nzb+1) = SUM( ql(nzb:nzt,j,i) * &
390	dzw(1:nzt+1) )
391	ENDDO
392	ENDDO
393	ELSE
394	IF ( .NOT. ALLOCATED( lwp_av ) ) THEN
395	ALLOCATE( lwp_av(nysg:nyng,nxlg:nxrg) )
396	lwp_av = REAL( fill_value, KIND = wp )
397	ENDIF
398	DO i = nxl, nxr
399	DO j = nys, nyn
400	local_pf(i,j,nzb+1) = lwp_av(j,i)
401	ENDDO
402	ENDDO
403	ENDIF
404	resorted = .TRUE.
405	two_d = .TRUE.
406	level_z(nzb+1) = zu(nzb+1)
407
408	CASE ( 'ghf*_xy' ) ! 2d-array
409	IF ( av == 0 ) THEN
410	DO m = 1, surf_lsm_h%ns
411	i = surf_lsm_h%i(m)
412	j = surf_lsm_h%j(m)
413	local_pf(i,j,nzb+1) = surf_lsm_h%ghf(m)
414	ENDDO
415	DO m = 1, surf_usm_h%ns
416	i = surf_usm_h%i(m)
417	j = surf_usm_h%j(m)
418	local_pf(i,j,nzb+1) = surf_usm_h%frac(ind_veg_wall,m) * &
419	surf_usm_h%wghf_eb(m) + &
420	surf_usm_h%frac(ind_pav_green,m) * &
421	surf_usm_h%wghf_eb_green(m) + &
422	surf_usm_h%frac(ind_wat_win,m) * &
423	surf_usm_h%wghf_eb_window(m)
424	ENDDO
425	ELSE
426	IF ( .NOT. ALLOCATED( ghf_av ) ) THEN
427	ALLOCATE( ghf_av(nysg:nyng,nxlg:nxrg) )
428	ghf_av = REAL( fill_value, KIND = wp )
429	ENDIF
430	DO i = nxl, nxr
431	DO j = nys, nyn
432	local_pf(i,j,nzb+1) = ghf_av(j,i)
433	ENDDO
434	ENDDO
435	ENDIF
436
437	resorted = .TRUE.
438	two_d = .TRUE.
439	level_z(nzb+1) = zu(nzb+1)
440
441	CASE ( 'ol*_xy' ) ! 2d-array
442	IF ( av == 0 ) THEN
443	DO m = 1, surf_def_h(0)%ns
444	i = surf_def_h(0)%i(m)
445	j = surf_def_h(0)%j(m)
446	local_pf(i,j,nzb+1) = surf_def_h(0)%ol(m)
447	ENDDO
448	DO m = 1, surf_lsm_h%ns
449	i = surf_lsm_h%i(m)
450	j = surf_lsm_h%j(m)
451	local_pf(i,j,nzb+1) = surf_lsm_h%ol(m)
452	ENDDO
453	DO m = 1, surf_usm_h%ns
454	i = surf_usm_h%i(m)
455	j = surf_usm_h%j(m)
456	local_pf(i,j,nzb+1) = surf_usm_h%ol(m)
457	ENDDO
458	ELSE
459	IF ( .NOT. ALLOCATED( ol_av ) ) THEN
460	ALLOCATE( ol_av(nysg:nyng,nxlg:nxrg) )
461	ol_av = REAL( fill_value, KIND = wp )
462	ENDIF
463	DO i = nxl, nxr
464	DO j = nys, nyn
465	local_pf(i,j,nzb+1) = ol_av(j,i)
466	ENDDO
467	ENDDO
468	ENDIF
469	resorted = .TRUE.
470	two_d = .TRUE.
471	level_z(nzb+1) = zu(nzb+1)
472
473	CASE ( 'p_xy', 'p_xz', 'p_yz' )
474	IF ( av == 0 ) THEN
475	IF ( psolver /= 'sor' ) CALL exchange_horiz( p, nbgp )
476	to_be_resorted => p
477	ELSE
478	IF ( .NOT. ALLOCATED( p_av ) ) THEN
479	ALLOCATE( p_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
480	p_av = REAL( fill_value, KIND = wp )
481	ENDIF
482	IF ( psolver /= 'sor' ) CALL exchange_horiz( p_av, nbgp )
483	to_be_resorted => p_av
484	ENDIF
485	IF ( mode == 'xy' ) level_z = zu
486
487	CASE ( 'pc_xy', 'pc_xz', 'pc_yz' ) ! particle concentration
488	IF ( av == 0 ) THEN
489	IF ( time_since_reference_point >= particle_advection_start ) THEN
490	tend = prt_count
491	! CALL exchange_horiz( tend, nbgp )
492	ELSE
493	tend = 0.0_wp
494	ENDIF
495	DO i = nxl, nxr
496	DO j = nys, nyn
497	DO k = nzb, nzt+1
498	local_pf(i,j,k) = tend(k,j,i)
499	ENDDO
500	ENDDO
501	ENDDO
502	resorted = .TRUE.
503	ELSE
504	IF ( .NOT. ALLOCATED( pc_av ) ) THEN
505	ALLOCATE( pc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
506	pc_av = REAL( fill_value, KIND = wp )
507	ENDIF
508	! CALL exchange_horiz( pc_av, nbgp )
509	to_be_resorted => pc_av
510	ENDIF
511
512	CASE ( 'pr_xy', 'pr_xz', 'pr_yz' ) ! mean particle radius (effective radius)
513	IF ( av == 0 ) THEN
514	IF ( time_since_reference_point >= particle_advection_start ) THEN
515	DO i = nxl, nxr
516	DO j = nys, nyn
517	DO k = nzb, nzt+1
518	number_of_particles = prt_count(k,j,i)
519	IF (number_of_particles <= 0) CYCLE
520	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
521	s_r2 = 0.0_wp
522	s_r3 = 0.0_wp
523	DO n = 1, number_of_particles
524	IF ( particles(n)%particle_mask ) THEN
525	s_r2 = s_r2 + particles(n)%radius*2 &
526	particles(n)%weight_factor
527	s_r3 = s_r3 + particles(n)%radius*3 &
528	particles(n)%weight_factor
529	ENDIF
530	ENDDO
531	IF ( s_r2 > 0.0_wp ) THEN
532	mean_r = s_r3 / s_r2
533	ELSE
534	mean_r = 0.0_wp
535	ENDIF
536	tend(k,j,i) = mean_r
537	ENDDO
538	ENDDO
539	ENDDO
540	! CALL exchange_horiz( tend, nbgp )
541	ELSE
542	tend = 0.0_wp
543	ENDIF
544	DO i = nxl, nxr
545	DO j = nys, nyn
546	DO k = nzb, nzt+1
547	local_pf(i,j,k) = tend(k,j,i)
548	ENDDO
549	ENDDO
550	ENDDO
551	resorted = .TRUE.
552	ELSE
553	IF ( .NOT. ALLOCATED( pr_av ) ) THEN
554	ALLOCATE( pr_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
555	pr_av = REAL( fill_value, KIND = wp )
556	ENDIF
557	! CALL exchange_horiz( pr_av, nbgp )
558	to_be_resorted => pr_av
559	ENDIF
560
561	CASE ( 'theta_xy', 'theta_xz', 'theta_yz' )
562	IF ( av == 0 ) THEN
563	IF ( .NOT. bulk_cloud_model ) THEN
564	to_be_resorted => pt
565	ELSE
566	DO i = nxl, nxr
567	DO j = nys, nyn
568	DO k = nzb, nzt+1
569	local_pf(i,j,k) = pt(k,j,i) + lv_d_cp * &
570	d_exner(k) * &
571	ql(k,j,i)
572	ENDDO
573	ENDDO
574	ENDDO
575	resorted = .TRUE.
576	ENDIF
577	ELSE
578	IF ( .NOT. ALLOCATED( pt_av ) ) THEN
579	ALLOCATE( pt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
580	pt_av = REAL( fill_value, KIND = wp )
581	ENDIF
582	to_be_resorted => pt_av
583	ENDIF
584	IF ( mode == 'xy' ) level_z = zu
585
586	CASE ( 'q_xy', 'q_xz', 'q_yz' )
587	IF ( av == 0 ) THEN
588	to_be_resorted => q
589	ELSE
590	IF ( .NOT. ALLOCATED( q_av ) ) THEN
591	ALLOCATE( q_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
592	q_av = REAL( fill_value, KIND = wp )
593	ENDIF
594	to_be_resorted => q_av
595	ENDIF
596	IF ( mode == 'xy' ) level_z = zu
597
598	CASE ( 'ql_xy', 'ql_xz', 'ql_yz' )
599	IF ( av == 0 ) THEN
600	to_be_resorted => ql
601	ELSE
602	IF ( .NOT. ALLOCATED( ql_av ) ) THEN
603	ALLOCATE( ql_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
604	ql_av = REAL( fill_value, KIND = wp )
605	ENDIF
606	to_be_resorted => ql_av
607	ENDIF
608	IF ( mode == 'xy' ) level_z = zu
609
610	CASE ( 'ql_c_xy', 'ql_c_xz', 'ql_c_yz' )
611	IF ( av == 0 ) THEN
612	to_be_resorted => ql_c
613	ELSE
614	IF ( .NOT. ALLOCATED( ql_c_av ) ) THEN
615	ALLOCATE( ql_c_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
616	ql_c_av = REAL( fill_value, KIND = wp )
617	ENDIF
618	to_be_resorted => ql_c_av
619	ENDIF
620	IF ( mode == 'xy' ) level_z = zu
621
622	CASE ( 'ql_v_xy', 'ql_v_xz', 'ql_v_yz' )
623	IF ( av == 0 ) THEN
624	to_be_resorted => ql_v
625	ELSE
626	IF ( .NOT. ALLOCATED( ql_v_av ) ) THEN
627	ALLOCATE( ql_v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
628	ql_v_av = REAL( fill_value, KIND = wp )
629	ENDIF
630	to_be_resorted => ql_v_av
631	ENDIF
632	IF ( mode == 'xy' ) level_z = zu
633
634	CASE ( 'ql_vp_xy', 'ql_vp_xz', 'ql_vp_yz' )
635	IF ( av == 0 ) THEN
636	IF ( time_since_reference_point >= particle_advection_start ) THEN
637	DO i = nxl, nxr
638	DO j = nys, nyn
639	DO k = nzb, nzt+1
640	number_of_particles = prt_count(k,j,i)
641	IF (number_of_particles <= 0) CYCLE
642	particles => grid_particles(k,j,i)%particles(1:number_of_particles)
643	DO n = 1, number_of_particles
644	IF ( particles(n)%particle_mask ) THEN
645	tend(k,j,i) = tend(k,j,i) + &
646	particles(n)%weight_factor / &
647	prt_count(k,j,i)
648	ENDIF
649	ENDDO
650	ENDDO
651	ENDDO
652	ENDDO
653	! CALL exchange_horiz( tend, nbgp )
654	ELSE
655	tend = 0.0_wp
656	ENDIF
657	DO i = nxl, nxr
658	DO j = nys, nyn
659	DO k = nzb, nzt+1
660	local_pf(i,j,k) = tend(k,j,i)
661	ENDDO
662	ENDDO
663	ENDDO
664	resorted = .TRUE.
665	ELSE
666	IF ( .NOT. ALLOCATED( ql_vp_av ) ) THEN
667	ALLOCATE( ql_vp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
668	ql_vp_av = REAL( fill_value, KIND = wp )
669	ENDIF
670	! CALL exchange_horiz( ql_vp_av, nbgp )
671	to_be_resorted => ql_vp_av
672	ENDIF
673	IF ( mode == 'xy' ) level_z = zu
674
675	CASE ( 'qsws*_xy' ) ! 2d-array
676	IF ( av == 0 ) THEN
677	local_pf(:,:,nzb+1) = REAL( fill_value, KIND = wp )
678	!
679	!-- In case of default surfaces, clean-up flux by density.
680	!-- In case of land-surfaces, convert fluxes into
681	!-- dynamic units
682	DO m = 1, surf_def_h(0)%ns
683	i = surf_def_h(0)%i(m)
684	j = surf_def_h(0)%j(m)
685	k = surf_def_h(0)%k(m)
686	local_pf(i,j,nzb+1) = surf_def_h(0)%qsws(m) * &
687	waterflux_output_conversion(k)
688	ENDDO
689	DO m = 1, surf_lsm_h%ns
690	i = surf_lsm_h%i(m)
691	j = surf_lsm_h%j(m)
692	k = surf_lsm_h%k(m)
693	local_pf(i,j,nzb+1) = surf_lsm_h%qsws(m) * l_v
694	ENDDO
695	DO m = 1, surf_usm_h%ns
696	i = surf_usm_h%i(m)
697	j = surf_usm_h%j(m)
698	k = surf_usm_h%k(m)
699	local_pf(i,j,nzb+1) = surf_usm_h%qsws(m) * l_v
700	ENDDO
701	ELSE
702	IF ( .NOT. ALLOCATED( qsws_av ) ) THEN
703	ALLOCATE( qsws_av(nysg:nyng,nxlg:nxrg) )
704	qsws_av = REAL( fill_value, KIND = wp )
705	ENDIF
706	DO i = nxl, nxr
707	DO j = nys, nyn
708	local_pf(i,j,nzb+1) = qsws_av(j,i)
709	ENDDO
710	ENDDO
711	ENDIF
712	resorted = .TRUE.
713	two_d = .TRUE.
714	level_z(nzb+1) = zu(nzb+1)
715
716	CASE ( 'qv_xy', 'qv_xz', 'qv_yz' )
717	IF ( av == 0 ) THEN
718	DO i = nxl, nxr
719	DO j = nys, nyn
720	DO k = nzb, nzt+1
721	local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
722	ENDDO
723	ENDDO
724	ENDDO
725	resorted = .TRUE.
726	ELSE
727	IF ( .NOT. ALLOCATED( qv_av ) ) THEN
728	ALLOCATE( qv_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
729	qv_av = REAL( fill_value, KIND = wp )
730	ENDIF
731	to_be_resorted => qv_av
732	ENDIF
733	IF ( mode == 'xy' ) level_z = zu
734
735	CASE ( 'r_a*_xy' ) ! 2d-array
736	IF ( av == 0 ) THEN
737	DO m = 1, surf_lsm_h%ns
738	i = surf_lsm_h%i(m)
739	j = surf_lsm_h%j(m)
740	local_pf(i,j,nzb+1) = surf_lsm_h%r_a(m)
741	ENDDO
742
743	DO m = 1, surf_usm_h%ns
744	i = surf_usm_h%i(m)
745	j = surf_usm_h%j(m)
746	local_pf(i,j,nzb+1) = &
747	( surf_usm_h%frac(ind_veg_wall,m) * &
748	surf_usm_h%r_a(m) + &
749	surf_usm_h%frac(ind_pav_green,m) * &
750	surf_usm_h%r_a_green(m) + &
751	surf_usm_h%frac(ind_wat_win,m) * &
752	surf_usm_h%r_a_window(m) )
753	ENDDO
754	ELSE
755	IF ( .NOT. ALLOCATED( r_a_av ) ) THEN
756	ALLOCATE( r_a_av(nysg:nyng,nxlg:nxrg) )
757	r_a_av = REAL( fill_value, KIND = wp )
758	ENDIF
759	DO i = nxl, nxr
760	DO j = nys, nyn
761	local_pf(i,j,nzb+1) = r_a_av(j,i)
762	ENDDO
763	ENDDO
764	ENDIF
765	resorted = .TRUE.
766	two_d = .TRUE.
767	level_z(nzb+1) = zu(nzb+1)
768
769	CASE ( 's_xy', 's_xz', 's_yz' )
770	IF ( av == 0 ) THEN
771	to_be_resorted => s
772	ELSE
773	IF ( .NOT. ALLOCATED( s_av ) ) THEN
774	ALLOCATE( s_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
775	s_av = REAL( fill_value, KIND = wp )
776	ENDIF
777	to_be_resorted => s_av
778	ENDIF
779
780	CASE ( 'shf*_xy' ) ! 2d-array
781	IF ( av == 0 ) THEN
782	!
783	!-- In case of default surfaces, clean-up flux by density.
784	!-- In case of land- and urban-surfaces, convert fluxes into
785	!-- dynamic units.
786	DO m = 1, surf_def_h(0)%ns
787	i = surf_def_h(0)%i(m)
788	j = surf_def_h(0)%j(m)
789	k = surf_def_h(0)%k(m)
790	local_pf(i,j,nzb+1) = surf_def_h(0)%shf(m) * &
791	heatflux_output_conversion(k)
792	ENDDO
793	DO m = 1, surf_lsm_h%ns
794	i = surf_lsm_h%i(m)
795	j = surf_lsm_h%j(m)
796	k = surf_lsm_h%k(m)
797	local_pf(i,j,nzb+1) = surf_lsm_h%shf(m) * c_p
798	ENDDO
799	DO m = 1, surf_usm_h%ns
800	i = surf_usm_h%i(m)
801	j = surf_usm_h%j(m)
802	k = surf_usm_h%k(m)
803	local_pf(i,j,nzb+1) = surf_usm_h%shf(m) * c_p
804	ENDDO
805	ELSE
806	IF ( .NOT. ALLOCATED( shf_av ) ) THEN
807	ALLOCATE( shf_av(nysg:nyng,nxlg:nxrg) )
808	shf_av = REAL( fill_value, KIND = wp )
809	ENDIF
810	DO i = nxl, nxr
811	DO j = nys, nyn
812	local_pf(i,j,nzb+1) = shf_av(j,i)
813	ENDDO
814	ENDDO
815	ENDIF
816	resorted = .TRUE.
817	two_d = .TRUE.
818	level_z(nzb+1) = zu(nzb+1)
819
820	CASE ( 'ssws*_xy' ) ! 2d-array
821	IF ( av == 0 ) THEN
822	DO m = 1, surf_def_h(0)%ns
823	i = surf_def_h(0)%i(m)
824	j = surf_def_h(0)%j(m)
825	local_pf(i,j,nzb+1) = surf_def_h(0)%ssws(m)
826	ENDDO
827	DO m = 1, surf_lsm_h%ns
828	i = surf_lsm_h%i(m)
829	j = surf_lsm_h%j(m)
830	local_pf(i,j,nzb+1) = surf_lsm_h%ssws(m)
831	ENDDO
832	DO m = 1, surf_usm_h%ns
833	i = surf_usm_h%i(m)
834	j = surf_usm_h%j(m)
835	local_pf(i,j,nzb+1) = surf_usm_h%ssws(m)
836	ENDDO
837	ELSE
838	IF ( .NOT. ALLOCATED( ssws_av ) ) THEN
839	ALLOCATE( ssws_av(nysg:nyng,nxlg:nxrg) )
840	ssws_av = REAL( fill_value, KIND = wp )
841	ENDIF
842	DO i = nxl, nxr
843	DO j = nys, nyn
844	local_pf(i,j,nzb+1) = ssws_av(j,i)
845	ENDDO
846	ENDDO
847	ENDIF
848	resorted = .TRUE.
849	two_d = .TRUE.
850	level_z(nzb+1) = zu(nzb+1)
851
852	CASE ( 't*_xy' ) ! 2d-array
853	IF ( av == 0 ) THEN
854	DO m = 1, surf_def_h(0)%ns
855	i = surf_def_h(0)%i(m)
856	j = surf_def_h(0)%j(m)
857	local_pf(i,j,nzb+1) = surf_def_h(0)%ts(m)
858	ENDDO
859	DO m = 1, surf_lsm_h%ns
860	i = surf_lsm_h%i(m)
861	j = surf_lsm_h%j(m)
862	local_pf(i,j,nzb+1) = surf_lsm_h%ts(m)
863	ENDDO
864	DO m = 1, surf_usm_h%ns
865	i = surf_usm_h%i(m)
866	j = surf_usm_h%j(m)
867	local_pf(i,j,nzb+1) = surf_usm_h%ts(m)
868	ENDDO
869	ELSE
870	IF ( .NOT. ALLOCATED( ts_av ) ) THEN
871	ALLOCATE( ts_av(nysg:nyng,nxlg:nxrg) )
872	ts_av = REAL( fill_value, KIND = wp )
873	ENDIF
874	DO i = nxl, nxr
875	DO j = nys, nyn
876	local_pf(i,j,nzb+1) = ts_av(j,i)
877	ENDDO
878	ENDDO
879	ENDIF
880	resorted = .TRUE.
881	two_d = .TRUE.
882	level_z(nzb+1) = zu(nzb+1)
883
884	CASE ( 'tsurf*_xy' ) ! 2d-array
885	IF ( av == 0 ) THEN
886	DO m = 1, surf_def_h(0)%ns
887	i = surf_def_h(0)%i(m)
888	j = surf_def_h(0)%j(m)
889	local_pf(i,j,nzb+1) = surf_def_h(0)%pt_surface(m)
890	ENDDO
891
892	DO m = 1, surf_lsm_h%ns
893	i = surf_lsm_h%i(m)
894	j = surf_lsm_h%j(m)
895	local_pf(i,j,nzb+1) = surf_lsm_h%pt_surface(m)
896	ENDDO
897
898	DO m = 1, surf_usm_h%ns
899	i = surf_usm_h%i(m)
900	j = surf_usm_h%j(m)
901	local_pf(i,j,nzb+1) = surf_usm_h%pt_surface(m)
902	ENDDO
903
904	ELSE
905	IF ( .NOT. ALLOCATED( tsurf_av ) ) THEN
906	ALLOCATE( tsurf_av(nysg:nyng,nxlg:nxrg) )
907	tsurf_av = REAL( fill_value, KIND = wp )
908	ENDIF
909	DO i = nxl, nxr
910	DO j = nys, nyn
911	local_pf(i,j,nzb+1) = tsurf_av(j,i)
912	ENDDO
913	ENDDO
914	ENDIF
915	resorted = .TRUE.
916	two_d = .TRUE.
917	level_z(nzb+1) = zu(nzb+1)
918
919	CASE ( 'u_xy', 'u_xz', 'u_yz' )
920	flag_nr = 1
921	IF ( av == 0 ) THEN
922	to_be_resorted => u
923	ELSE
924	IF ( .NOT. ALLOCATED( u_av ) ) THEN
925	ALLOCATE( u_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
926	u_av = REAL( fill_value, KIND = wp )
927	ENDIF
928	to_be_resorted => u_av
929	ENDIF
930	IF ( mode == 'xy' ) level_z = zu
931	!
932	!-- Substitute the values generated by "mirror" boundary condition
933	!-- at the bottom boundary by the real surface values.
934	IF ( do2d(av,ivar) == 'u_xz' .OR. do2d(av,ivar) == 'u_yz' ) THEN
935	IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0_wp
936	ENDIF
937
938	CASE ( 'us*_xy' ) ! 2d-array
939	IF ( av == 0 ) THEN
940	DO m = 1, surf_def_h(0)%ns
941	i = surf_def_h(0)%i(m)
942	j = surf_def_h(0)%j(m)
943	local_pf(i,j,nzb+1) = surf_def_h(0)%us(m)
944	ENDDO
945	DO m = 1, surf_lsm_h%ns
946	i = surf_lsm_h%i(m)
947	j = surf_lsm_h%j(m)
948	local_pf(i,j,nzb+1) = surf_lsm_h%us(m)
949	ENDDO
950	DO m = 1, surf_usm_h%ns
951	i = surf_usm_h%i(m)
952	j = surf_usm_h%j(m)
953	local_pf(i,j,nzb+1) = surf_usm_h%us(m)
954	ENDDO
955	ELSE
956	IF ( .NOT. ALLOCATED( us_av ) ) THEN
957	ALLOCATE( us_av(nysg:nyng,nxlg:nxrg) )
958	us_av = REAL( fill_value, KIND = wp )
959	ENDIF
960	DO i = nxl, nxr
961	DO j = nys, nyn
962	local_pf(i,j,nzb+1) = us_av(j,i)
963	ENDDO
964	ENDDO
965	ENDIF
966	resorted = .TRUE.
967	two_d = .TRUE.
968	level_z(nzb+1) = zu(nzb+1)
969
970	CASE ( 'v_xy', 'v_xz', 'v_yz' )
971	flag_nr = 2
972	IF ( av == 0 ) THEN
973	to_be_resorted => v
974	ELSE
975	IF ( .NOT. ALLOCATED( v_av ) ) THEN
976	ALLOCATE( v_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
977	v_av = REAL( fill_value, KIND = wp )
978	ENDIF
979	to_be_resorted => v_av
980	ENDIF
981	IF ( mode == 'xy' ) level_z = zu
982	!
983	!-- Substitute the values generated by "mirror" boundary condition
984	!-- at the bottom boundary by the real surface values.
985	IF ( do2d(av,ivar) == 'v_xz' .OR. do2d(av,ivar) == 'v_yz' ) THEN
986	IF ( ibc_uv_b == 0 ) local_pf(:,:,nzb) = 0.0_wp
987	ENDIF
988
989	CASE ( 'thetav_xy', 'thetav_xz', 'thetav_yz' )
990	IF ( av == 0 ) THEN
991	to_be_resorted => vpt
992	ELSE
993	IF ( .NOT. ALLOCATED( vpt_av ) ) THEN
994	ALLOCATE( vpt_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
995	vpt_av = REAL( fill_value, KIND = wp )
996	ENDIF
997	to_be_resorted => vpt_av
998	ENDIF
999	IF ( mode == 'xy' ) level_z = zu
1000
1001	CASE ( 'theta_2m*_xy' ) ! 2d-array
1002	IF ( av == 0 ) THEN
1003	DO m = 1, surf_def_h(0)%ns
1004	i = surf_def_h(0)%i(m)
1005	j = surf_def_h(0)%j(m)
1006	local_pf(i,j,nzb+1) = surf_def_h(0)%pt_2m(m)
1007	ENDDO
1008	DO m = 1, surf_lsm_h%ns
1009	i = surf_lsm_h%i(m)
1010	j = surf_lsm_h%j(m)
1011	local_pf(i,j,nzb+1) = surf_lsm_h%pt_2m(m)
1012	ENDDO
1013	DO m = 1, surf_usm_h%ns
1014	i = surf_usm_h%i(m)
1015	j = surf_usm_h%j(m)
1016	local_pf(i,j,nzb+1) = surf_usm_h%pt_2m(m)
1017	ENDDO
1018	ELSE
1019	IF ( .NOT. ALLOCATED( pt_2m_av ) ) THEN
1020	ALLOCATE( pt_2m_av(nysg:nyng,nxlg:nxrg) )
1021	pt_2m_av = REAL( fill_value, KIND = wp )
1022	ENDIF
1023	DO i = nxl, nxr
1024	DO j = nys, nyn
1025	local_pf(i,j,nzb+1) = pt_2m_av(j,i)
1026	ENDDO
1027	ENDDO
1028	ENDIF
1029	resorted = .TRUE.
1030	two_d = .TRUE.
1031	level_z(nzb+1) = zu(nzb+1)
1032
1033	CASE ( 'w_xy', 'w_xz', 'w_yz' )
1034	flag_nr = 3
1035	IF ( av == 0 ) THEN
1036	to_be_resorted => w
1037	ELSE
1038	IF ( .NOT. ALLOCATED( w_av ) ) THEN
1039	ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1040	w_av = REAL( fill_value, KIND = wp )
1041	ENDIF
1042	to_be_resorted => w_av
1043	ENDIF
1044	IF ( mode == 'xy' ) level_z = zw
1045
1046	CASE ( 'z0*_xy' ) ! 2d-array
1047	IF ( av == 0 ) THEN
1048	DO m = 1, surf_def_h(0)%ns
1049	i = surf_def_h(0)%i(m)
1050	j = surf_def_h(0)%j(m)
1051	local_pf(i,j,nzb+1) = surf_def_h(0)%z0(m)
1052	ENDDO
1053	DO m = 1, surf_lsm_h%ns
1054	i = surf_lsm_h%i(m)
1055	j = surf_lsm_h%j(m)
1056	local_pf(i,j,nzb+1) = surf_lsm_h%z0(m)
1057	ENDDO
1058	DO m = 1, surf_usm_h%ns
1059	i = surf_usm_h%i(m)
1060	j = surf_usm_h%j(m)
1061	local_pf(i,j,nzb+1) = surf_usm_h%z0(m)
1062	ENDDO
1063	ELSE
1064	IF ( .NOT. ALLOCATED( z0_av ) ) THEN
1065	ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
1066	z0_av = REAL( fill_value, KIND = wp )
1067	ENDIF
1068	DO i = nxl, nxr
1069	DO j = nys, nyn
1070	local_pf(i,j,nzb+1) = z0_av(j,i)
1071	ENDDO
1072	ENDDO
1073	ENDIF
1074	resorted = .TRUE.
1075	two_d = .TRUE.
1076	level_z(nzb+1) = zu(nzb+1)
1077
1078	CASE ( 'z0h*_xy' ) ! 2d-array
1079	IF ( av == 0 ) THEN
1080	DO m = 1, surf_def_h(0)%ns
1081	i = surf_def_h(0)%i(m)
1082	j = surf_def_h(0)%j(m)
1083	local_pf(i,j,nzb+1) = surf_def_h(0)%z0h(m)
1084	ENDDO
1085	DO m = 1, surf_lsm_h%ns
1086	i = surf_lsm_h%i(m)
1087	j = surf_lsm_h%j(m)
1088	local_pf(i,j,nzb+1) = surf_lsm_h%z0h(m)
1089	ENDDO
1090	DO m = 1, surf_usm_h%ns
1091	i = surf_usm_h%i(m)
1092	j = surf_usm_h%j(m)
1093	local_pf(i,j,nzb+1) = surf_usm_h%z0h(m)
1094	ENDDO
1095	ELSE
1096	IF ( .NOT. ALLOCATED( z0h_av ) ) THEN
1097	ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
1098	z0h_av = REAL( fill_value, KIND = wp )
1099	ENDIF
1100	DO i = nxl, nxr
1101	DO j = nys, nyn
1102	local_pf(i,j,nzb+1) = z0h_av(j,i)
1103	ENDDO
1104	ENDDO
1105	ENDIF
1106	resorted = .TRUE.
1107	two_d = .TRUE.
1108	level_z(nzb+1) = zu(nzb+1)
1109
1110	CASE ( 'z0q*_xy' ) ! 2d-array
1111	IF ( av == 0 ) THEN
1112	DO m = 1, surf_def_h(0)%ns
1113	i = surf_def_h(0)%i(m)
1114	j = surf_def_h(0)%j(m)
1115	local_pf(i,j,nzb+1) = surf_def_h(0)%z0q(m)
1116	ENDDO
1117	DO m = 1, surf_lsm_h%ns
1118	i = surf_lsm_h%i(m)
1119	j = surf_lsm_h%j(m)
1120	local_pf(i,j,nzb+1) = surf_lsm_h%z0q(m)
1121	ENDDO
1122	DO m = 1, surf_usm_h%ns
1123	i = surf_usm_h%i(m)
1124	j = surf_usm_h%j(m)
1125	local_pf(i,j,nzb+1) = surf_usm_h%z0q(m)
1126	ENDDO
1127	ELSE
1128	IF ( .NOT. ALLOCATED( z0q_av ) ) THEN
1129	ALLOCATE( z0q_av(nysg:nyng,nxlg:nxrg) )
1130	z0q_av = REAL( fill_value, KIND = wp )
1131	ENDIF
1132	DO i = nxl, nxr
1133	DO j = nys, nyn
1134	local_pf(i,j,nzb+1) = z0q_av(j,i)
1135	ENDDO
1136	ENDDO
1137	ENDIF
1138	resorted = .TRUE.
1139	two_d = .TRUE.
1140	level_z(nzb+1) = zu(nzb+1)
1141
1142	CASE DEFAULT
1143
1144	!
1145	!-- Quantities of other modules
1146	IF ( .NOT. found ) THEN
1147	CALL module_interface_data_output_2d( &
1148	av, do2d(av,ivar), found, grid, mode, &
1149	local_pf, two_d, nzb_do, nzt_do, &
1150	fill_value &
1151	)
1152	ENDIF
1153
1154	resorted = .TRUE.
1155
1156	IF ( grid == 'zu' ) THEN
1157	IF ( mode == 'xy' ) level_z = zu
1158	ELSEIF ( grid == 'zw' ) THEN
1159	IF ( mode == 'xy' ) level_z = zw
1160	ELSEIF ( grid == 'zu1' ) THEN
1161	IF ( mode == 'xy' ) level_z(nzb+1) = zu(nzb+1)
1162	ELSEIF ( grid == 'zs' ) THEN
1163	IF ( mode == 'xy' ) level_z = zs
1164	ENDIF
1165
1166	IF ( .NOT. found ) THEN
1167	message_string = 'no output provided for: ' // &
1168	TRIM( do2d(av,ivar) )
1169	CALL message( 'data_output_2d', 'PA0181', 0, 0, 0, 6, 0 )
1170	ENDIF
1171
1172	END SELECT
1173
1174	!
1175	!-- Resort the array to be output, if not done above. Flag topography
1176	!-- grid points with fill values, using the corresponding maksing flag.
1177	IF ( .NOT. resorted ) THEN
1178	DO i = nxl, nxr
1179	DO j = nys, nyn
1180	DO k = nzb_do, nzt_do
1181	local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i), &
1182	REAL( fill_value, KIND = wp ), &
1183	BTEST( wall_flags_0(k,j,i), &
1184	flag_nr ) )
1185	ENDDO
1186	ENDDO
1187	ENDDO
1188	ENDIF
1189
1190	!
1191	!-- Output of the individual cross-sections, depending on the cross-
1192	!-- section mode chosen.
1193	is = 1
1194	loop1: DO WHILE ( section(is,s_ind) /= -9999 .OR. two_d )
1195
1196	SELECT CASE ( mode )
1197
1198	CASE ( 'xy' )
1199	!
1200	!-- Determine the cross section index
1201	IF ( two_d ) THEN
1202	layer_xy = nzb+1
1203	ELSE
1204	layer_xy = section(is,s_ind)
1205	ENDIF
1206
1207	!
1208	!-- Exit the loop for layers beyond the data output domain
1209	!-- (used for soil model)
1210	IF ( layer_xy > nzt_do ) THEN
1211	EXIT loop1
1212	ENDIF
1213
1214	!
1215	!-- Update the netCDF xy cross section time axis.
1216	!-- In case of parallel output, this is only done by PE0
1217	!-- to increase the performance.
1218	IF ( time_since_reference_point /= do2d_xy_last_time(av) ) THEN
1219	do2d_xy_time_count(av) = do2d_xy_time_count(av) + 1
1220	do2d_xy_last_time(av) = time_since_reference_point
1221	IF ( myid == 0 ) THEN
1222	IF ( .NOT. data_output_2d_on_each_pe &
1223	.OR. netcdf_data_format > 4 ) &
1224	THEN
1225	#if defined( __netcdf )
1226	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1227	id_var_time_xy(av), &
1228	(/ time_since_reference_point /), &
1229	start = (/ do2d_xy_time_count(av) /), &
1230	count = (/ 1 /) )
1231	CALL netcdf_handle_error( 'data_output_2d', 53 )
1232	#endif
1233	ENDIF
1234	ENDIF
1235	ENDIF
1236	!
1237	!-- If required, carry out averaging along z
1238	IF ( section(is,s_ind) == -1 .AND. .NOT. two_d ) THEN
1239
1240	local_2d = 0.0_wp
1241	!
1242	!-- Carry out the averaging (all data are on the PE)
1243	DO k = nzb_do, nzt_do
1244	DO j = nys, nyn
1245	DO i = nxl, nxr
1246	local_2d(i,j) = local_2d(i,j) + local_pf(i,j,k)
1247	ENDDO
1248	ENDDO
1249	ENDDO
1250
1251	local_2d = local_2d / ( nzt_do - nzb_do + 1.0_wp)
1252
1253	ELSE
1254	!
1255	!-- Just store the respective section on the local array
1256	local_2d = local_pf(:,:,layer_xy)
1257
1258	ENDIF
1259
1260	#if defined( __parallel )
1261	IF ( netcdf_data_format > 4 ) THEN
1262	!
1263	!-- Parallel output in netCDF4/HDF5 format.
1264	IF ( two_d ) THEN
1265	iis = 1
1266	ELSE
1267	iis = is
1268	ENDIF
1269
1270	#if defined( __netcdf )
1271	!
1272	!-- For parallel output, all cross sections are first stored
1273	!-- here on a local array and will be written to the output
1274	!-- file afterwards to increase the performance.
1275	DO i = nxl, nxr
1276	DO j = nys, nyn
1277	local_2d_sections(i,j,iis) = local_2d(i,j)
1278	ENDDO
1279	ENDDO
1280	#endif
1281	ELSE
1282
1283	IF ( data_output_2d_on_each_pe ) THEN
1284	!
1285	!-- Output of partial arrays on each PE
1286	#if defined( __netcdf )
1287	IF ( myid == 0 ) THEN
1288	WRITE ( 21 ) time_since_reference_point, &
1289	do2d_xy_time_count(av), av
1290	ENDIF
1291	#endif
1292	DO i = 0, io_blocks-1
1293	IF ( i == io_group ) THEN
1294	WRITE ( 21 ) nxl, nxr, nys, nyn, nys, nyn
1295	WRITE ( 21 ) local_2d
1296	ENDIF
1297	#if defined( __parallel )
1298	CALL MPI_BARRIER( comm2d, ierr )
1299	#endif
1300	ENDDO
1301
1302	ELSE
1303	!
1304	!-- PE0 receives partial arrays from all processors and
1305	!-- then outputs them. Here a barrier has to be set,
1306	!-- because otherwise "-MPI- FATAL: Remote protocol queue
1307	!-- full" may occur.
1308	CALL MPI_BARRIER( comm2d, ierr )
1309
1310	ngp = ( nxr-nxl+1 ) * ( nyn-nys+1 )
1311	IF ( myid == 0 ) THEN
1312	!
1313	!-- Local array can be relocated directly.
1314	total_2d(nxl:nxr,nys:nyn) = local_2d
1315	!
1316	!-- Receive data from all other PEs.
1317	DO n = 1, numprocs-1
1318	!
1319	!-- Receive index limits first, then array.
1320	!-- Index limits are received in arbitrary order from
1321	!-- the PEs.
1322	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
1323	MPI_ANY_SOURCE, 0, comm2d, &
1324	status, ierr )
1325	sender = status(MPI_SOURCE)
1326	DEALLOCATE( local_2d )
1327	ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
1328	CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
1329	MPI_REAL, sender, 1, comm2d, &
1330	status, ierr )
1331	total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
1332	ENDDO
1333	!
1334	!-- Relocate the local array for the next loop increment
1335	DEALLOCATE( local_2d )
1336	ALLOCATE( local_2d(nxl:nxr,nys:nyn) )
1337
1338	#if defined( __netcdf )
1339	IF ( two_d ) THEN
1340	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1341	id_var_do2d(av,ivar), &
1342	total_2d(0:nx,0:ny), &
1343	start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
1344	count = (/ nx+1, ny+1, 1, 1 /) )
1345	ELSE
1346	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1347	id_var_do2d(av,ivar), &
1348	total_2d(0:nx,0:ny), &
1349	start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
1350	count = (/ nx+1, ny+1, 1, 1 /) )
1351	ENDIF
1352	CALL netcdf_handle_error( 'data_output_2d', 54 )
1353	#endif
1354
1355	ELSE
1356	!
1357	!-- First send the local index limits to PE0
1358	ind(1) = nxl; ind(2) = nxr
1359	ind(3) = nys; ind(4) = nyn
1360	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
1361	comm2d, ierr )
1362	!
1363	!-- Send data to PE0
1364	CALL MPI_SEND( local_2d(nxl,nys), ngp, &
1365	MPI_REAL, 0, 1, comm2d, ierr )
1366	ENDIF
1367	!
1368	!-- A barrier has to be set, because otherwise some PEs may
1369	!-- proceed too fast so that PE0 may receive wrong data on
1370	!-- tag 0
1371	CALL MPI_BARRIER( comm2d, ierr )
1372	ENDIF
1373
1374	ENDIF
1375	#else
1376	#if defined( __netcdf )
1377	IF ( two_d ) THEN
1378	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1379	id_var_do2d(av,ivar), &
1380	local_2d(nxl:nxr,nys:nyn), &
1381	start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
1382	count = (/ nx+1, ny+1, 1, 1 /) )
1383	ELSE
1384	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1385	id_var_do2d(av,ivar), &
1386	local_2d(nxl:nxr,nys:nyn), &
1387	start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
1388	count = (/ nx+1, ny+1, 1, 1 /) )
1389	ENDIF
1390	CALL netcdf_handle_error( 'data_output_2d', 447 )
1391	#endif
1392	#endif
1393
1394	!
1395	!-- For 2D-arrays (e.g. u*) only one cross-section is available.
1396	!-- Hence exit loop of output levels.
1397	IF ( two_d ) THEN
1398	IF ( netcdf_data_format < 5 ) two_d = .FALSE.
1399	EXIT loop1
1400	ENDIF
1401
1402	CASE ( 'xz' )
1403	!
1404	!-- Update the netCDF xz cross section time axis.
1405	!-- In case of parallel output, this is only done by PE0
1406	!-- to increase the performance.
1407	IF ( time_since_reference_point /= do2d_xz_last_time(av) ) THEN
1408	do2d_xz_time_count(av) = do2d_xz_time_count(av) + 1
1409	do2d_xz_last_time(av) = time_since_reference_point
1410	IF ( myid == 0 ) THEN
1411	IF ( .NOT. data_output_2d_on_each_pe &
1412	.OR. netcdf_data_format > 4 ) &
1413	THEN
1414	#if defined( __netcdf )
1415	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
1416	id_var_time_xz(av), &
1417	(/ time_since_reference_point /), &
1418	start = (/ do2d_xz_time_count(av) /), &
1419	count = (/ 1 /) )
1420	CALL netcdf_handle_error( 'data_output_2d', 56 )
1421	#endif
1422	ENDIF
1423	ENDIF
1424	ENDIF
1425
1426	!
1427	!-- If required, carry out averaging along y
1428	IF ( section(is,s_ind) == -1 ) THEN
1429
1430	ALLOCATE( local_2d_l(nxl:nxr,nzb_do:nzt_do) )
1431	local_2d_l = 0.0_wp
1432	ngp = ( nxr-nxl + 1 ) * ( nzt_do-nzb_do + 1 )
1433	!
1434	!-- First local averaging on the PE
1435	DO k = nzb_do, nzt_do
1436	DO j = nys, nyn
1437	DO i = nxl, nxr
1438	local_2d_l(i,k) = local_2d_l(i,k) + &
1439	local_pf(i,j,k)
1440	ENDDO
1441	ENDDO
1442	ENDDO
1443	#if defined( __parallel )
1444	!
1445	!-- Now do the averaging over all PEs along y
1446	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
1447	CALL MPI_ALLREDUCE( local_2d_l(nxl,nzb_do), &
1448	local_2d(nxl,nzb_do), ngp, MPI_REAL, &
1449	MPI_SUM, comm1dy, ierr )
1450	#else
1451	local_2d = local_2d_l
1452	#endif
1453	local_2d = local_2d / ( ny + 1.0_wp )
1454
1455	DEALLOCATE( local_2d_l )
1456
1457	ELSE
1458	!
1459	!-- Just store the respective section on the local array
1460	!-- (but only if it is available on this PE!)
1461	IF ( section(is,s_ind) >= nys .AND. section(is,s_ind) <= nyn ) &
1462	THEN
1463	local_2d = local_pf(:,section(is,s_ind),nzb_do:nzt_do)
1464	ENDIF
1465
1466	ENDIF
1467
1468	#if defined( __parallel )
1469	IF ( netcdf_data_format > 4 ) THEN
1470	!
1471	!-- Output in netCDF4/HDF5 format.
1472	!-- Output only on those PEs where the respective cross
1473	!-- sections reside. Cross sections averaged along y are
1474	!-- output on the respective first PE along y (myidy=0).
1475	IF ( ( section(is,s_ind) >= nys .AND. &
1476	section(is,s_ind) <= nyn ) .OR. &
1477	( section(is,s_ind) == -1 .AND. myidy == 0 ) ) THEN
1478	#if defined( __netcdf )
1479	!
1480	!-- For parallel output, all cross sections are first
1481	!-- stored here on a local array and will be written to the
1482	!-- output file afterwards to increase the performance.
1483	DO i = nxl, nxr
1484	DO k = nzb_do, nzt_do
1485	local_2d_sections_l(i,is,k) = local_2d(i,k)
1486	ENDDO
1487	ENDDO
1488	#endif
1489	ENDIF
1490
1491	ELSE
1492
1493	IF ( data_output_2d_on_each_pe ) THEN
1494	!
1495	!-- Output of partial arrays on each PE. If the cross
1496	!-- section does not reside on the PE, output special
1497	!-- index values.
1498	#if defined( __netcdf )
1499	IF ( myid == 0 ) THEN
1500	WRITE ( 22 ) time_since_reference_point, &
1501	do2d_xz_time_count(av), av
1502	ENDIF
1503	#endif
1504	DO i = 0, io_blocks-1
1505	IF ( i == io_group ) THEN
1506	IF ( ( section(is,s_ind) >= nys .AND. &
1507	section(is,s_ind) <= nyn ) .OR. &
1508	( section(is,s_ind) == -1 .AND. &
1509	nys-1 == -1 ) ) &
1510	THEN
1511	WRITE (22) nxl, nxr, nzb_do, nzt_do, nzb, nzt+1
1512	WRITE (22) local_2d
1513	ELSE
1514	WRITE (22) -1, -1, -1, -1, -1, -1
1515	ENDIF
1516	ENDIF
1517	#if defined( __parallel )
1518	CALL MPI_BARRIER( comm2d, ierr )
1519	#endif
1520	ENDDO
1521
1522	ELSE
1523	!
1524	!-- PE0 receives partial arrays from all processors of the
1525	!-- respective cross section and outputs them. Here a
1526	!-- barrier has to be set, because otherwise
1527	!-- "-MPI- FATAL: Remote protocol queue full" may occur.
1528	CALL MPI_BARRIER( comm2d, ierr )
1529
1530	ngp = ( nxr-nxl + 1 ) * ( nzt_do-nzb_do + 1 )
1531	IF ( myid == 0 ) THEN
1532	!
1533	!-- Local array can be relocated directly.
1534	IF ( ( section(is,s_ind) >= nys .AND. &
1535	section(is,s_ind) <= nyn ) .OR. &
1536	( section(is,s_ind) == -1 .AND. &
1537	nys-1 == -1 ) ) THEN
1538	total_2d(nxl:nxr,nzb_do:nzt_do) = local_2d
1539	ENDIF
1540	!
1541	!-- Receive data from all other PEs.
1542	DO n = 1, numprocs-1
1543	!
1544	!-- Receive index limits first, then array.
1545	!-- Index limits are received in arbitrary order from
1546	!-- the PEs.
1547	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
1548	MPI_ANY_SOURCE, 0, comm2d, &
1549	status, ierr )
1550	!
1551	!-- Not all PEs have data for XZ-cross-section.
1552	IF ( ind(1) /= -9999 ) THEN
1553	sender = status(MPI_SOURCE)
1554	DEALLOCATE( local_2d )
1555	ALLOCATE( local_2d(ind(1):ind(2), &
1556	ind(3):ind(4)) )
1557	CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
1558	MPI_REAL, sender, 1, comm2d, &
1559	status, ierr )
1560	total_2d(ind(1):ind(2),ind(3):ind(4)) = &
1561	local_2d
1562	ENDIF
1563	ENDDO
1564	!
1565	!-- Relocate the local array for the next loop increment
1566	DEALLOCATE( local_2d )
1567	ALLOCATE( local_2d(nxl:nxr,nzb_do:nzt_do) )
1568
1569	#if defined( __netcdf )
1570	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
1571	id_var_do2d(av,ivar), &
1572	total_2d(0:nx,nzb_do:nzt_do), &
1573	start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
1574	count = (/ nx+1, 1, nzt_do-nzb_do+1, 1 /) )
1575	CALL netcdf_handle_error( 'data_output_2d', 58 )
1576	#endif
1577
1578	ELSE
1579	!
1580	!-- If the cross section resides on the PE, send the
1581	!-- local index limits, otherwise send -9999 to PE0.
1582	IF ( ( section(is,s_ind) >= nys .AND. &
1583	section(is,s_ind) <= nyn ) .OR. &
1584	( section(is,s_ind) == -1 .AND. nys-1 == -1 ) ) &
1585	THEN
1586	ind(1) = nxl; ind(2) = nxr
1587	ind(3) = nzb_do; ind(4) = nzt_do
1588	ELSE
1589	ind(1) = -9999; ind(2) = -9999
1590	ind(3) = -9999; ind(4) = -9999
1591	ENDIF
1592	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
1593	comm2d, ierr )
1594	!
1595	!-- If applicable, send data to PE0.
1596	IF ( ind(1) /= -9999 ) THEN
1597	CALL MPI_SEND( local_2d(nxl,nzb_do), ngp, &
1598	MPI_REAL, 0, 1, comm2d, ierr )
1599	ENDIF
1600	ENDIF
1601	!
1602	!-- A barrier has to be set, because otherwise some PEs may
1603	!-- proceed too fast so that PE0 may receive wrong data on
1604	!-- tag 0
1605	CALL MPI_BARRIER( comm2d, ierr )
1606	ENDIF
1607
1608	ENDIF
1609	#else
1610	#if defined( __netcdf )
1611	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
1612	id_var_do2d(av,ivar), &
1613	local_2d(nxl:nxr,nzb_do:nzt_do), &
1614	start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
1615	count = (/ nx+1, 1, nzt_do-nzb_do+1, 1 /) )
1616	CALL netcdf_handle_error( 'data_output_2d', 451 )
1617	#endif
1618	#endif
1619
1620	CASE ( 'yz' )
1621	!
1622	!-- Update the netCDF yz cross section time axis.
1623	!-- In case of parallel output, this is only done by PE0
1624	!-- to increase the performance.
1625	IF ( time_since_reference_point /= do2d_yz_last_time(av) ) THEN
1626	do2d_yz_time_count(av) = do2d_yz_time_count(av) + 1
1627	do2d_yz_last_time(av) = time_since_reference_point
1628	IF ( myid == 0 ) THEN
1629	IF ( .NOT. data_output_2d_on_each_pe &
1630	.OR. netcdf_data_format > 4 ) &
1631	THEN
1632	#if defined( __netcdf )
1633	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
1634	id_var_time_yz(av), &
1635	(/ time_since_reference_point /), &
1636	start = (/ do2d_yz_time_count(av) /), &
1637	count = (/ 1 /) )
1638	CALL netcdf_handle_error( 'data_output_2d', 59 )
1639	#endif
1640	ENDIF
1641	ENDIF
1642	ENDIF
1643
1644	!
1645	!-- If required, carry out averaging along x
1646	IF ( section(is,s_ind) == -1 ) THEN
1647
1648	ALLOCATE( local_2d_l(nys:nyn,nzb_do:nzt_do) )
1649	local_2d_l = 0.0_wp
1650	ngp = ( nyn-nys+1 ) * ( nzt_do-nzb_do+1 )
1651	!
1652	!-- First local averaging on the PE
1653	DO k = nzb_do, nzt_do
1654	DO j = nys, nyn
1655	DO i = nxl, nxr
1656	local_2d_l(j,k) = local_2d_l(j,k) + &
1657	local_pf(i,j,k)
1658	ENDDO
1659	ENDDO
1660	ENDDO
1661	#if defined( __parallel )
1662	!
1663	!-- Now do the averaging over all PEs along x
1664	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
1665	CALL MPI_ALLREDUCE( local_2d_l(nys,nzb_do), &
1666	local_2d(nys,nzb_do), ngp, MPI_REAL, &
1667	MPI_SUM, comm1dx, ierr )
1668	#else
1669	local_2d = local_2d_l
1670	#endif
1671	local_2d = local_2d / ( nx + 1.0_wp )
1672
1673	DEALLOCATE( local_2d_l )
1674
1675	ELSE
1676	!
1677	!-- Just store the respective section on the local array
1678	!-- (but only if it is available on this PE!)
1679	IF ( section(is,s_ind) >= nxl .AND. section(is,s_ind) <= nxr ) &
1680	THEN
1681	local_2d = local_pf(section(is,s_ind),:,nzb_do:nzt_do)
1682	ENDIF
1683
1684	ENDIF
1685
1686	#if defined( __parallel )
1687	IF ( netcdf_data_format > 4 ) THEN
1688	!
1689	!-- Output in netCDF4/HDF5 format.
1690	!-- Output only on those PEs where the respective cross
1691	!-- sections reside. Cross sections averaged along x are
1692	!-- output on the respective first PE along x (myidx=0).
1693	IF ( ( section(is,s_ind) >= nxl .AND. &
1694	section(is,s_ind) <= nxr ) .OR. &
1695	( section(is,s_ind) == -1 .AND. myidx == 0 ) ) THEN
1696	#if defined( __netcdf )
1697	!
1698	!-- For parallel output, all cross sections are first
1699	!-- stored here on a local array and will be written to the
1700	!-- output file afterwards to increase the performance.
1701	DO j = nys, nyn
1702	DO k = nzb_do, nzt_do
1703	local_2d_sections_l(is,j,k) = local_2d(j,k)
1704	ENDDO
1705	ENDDO
1706	#endif
1707	ENDIF
1708
1709	ELSE
1710
1711	IF ( data_output_2d_on_each_pe ) THEN
1712	!
1713	!-- Output of partial arrays on each PE. If the cross
1714	!-- section does not reside on the PE, output special
1715	!-- index values.
1716	#if defined( __netcdf )
1717	IF ( myid == 0 ) THEN
1718	WRITE ( 23 ) time_since_reference_point, &
1719	do2d_yz_time_count(av), av
1720	ENDIF
1721	#endif
1722	DO i = 0, io_blocks-1
1723	IF ( i == io_group ) THEN
1724	IF ( ( section(is,s_ind) >= nxl .AND. &
1725	section(is,s_ind) <= nxr ) .OR. &
1726	( section(is,s_ind) == -1 .AND. &
1727	nxl-1 == -1 ) ) &
1728	THEN
1729	WRITE (23) nys, nyn, nzb_do, nzt_do, nzb, nzt+1
1730	WRITE (23) local_2d
1731	ELSE
1732	WRITE (23) -1, -1, -1, -1, -1, -1
1733	ENDIF
1734	ENDIF
1735	#if defined( __parallel )
1736	CALL MPI_BARRIER( comm2d, ierr )
1737	#endif
1738	ENDDO
1739
1740	ELSE
1741	!
1742	!-- PE0 receives partial arrays from all processors of the
1743	!-- respective cross section and outputs them. Here a
1744	!-- barrier has to be set, because otherwise
1745	!-- "-MPI- FATAL: Remote protocol queue full" may occur.
1746	CALL MPI_BARRIER( comm2d, ierr )
1747
1748	ngp = ( nyn-nys+1 ) * ( nzt_do-nzb_do+1 )
1749	IF ( myid == 0 ) THEN
1750	!
1751	!-- Local array can be relocated directly.
1752	IF ( ( section(is,s_ind) >= nxl .AND. &
1753	section(is,s_ind) <= nxr ) .OR. &
1754	( section(is,s_ind) == -1 .AND. nxl-1 == -1 ) ) &
1755	THEN
1756	total_2d(nys:nyn,nzb_do:nzt_do) = local_2d
1757	ENDIF
1758	!
1759	!-- Receive data from all other PEs.
1760	DO n = 1, numprocs-1
1761	!
1762	!-- Receive index limits first, then array.
1763	!-- Index limits are received in arbitrary order from
1764	!-- the PEs.
1765	CALL MPI_RECV( ind(1), 4, MPI_INTEGER, &
1766	MPI_ANY_SOURCE, 0, comm2d, &
1767	status, ierr )
1768	!
1769	!-- Not all PEs have data for YZ-cross-section.
1770	IF ( ind(1) /= -9999 ) THEN
1771	sender = status(MPI_SOURCE)
1772	DEALLOCATE( local_2d )
1773	ALLOCATE( local_2d(ind(1):ind(2), &
1774	ind(3):ind(4)) )
1775	CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
1776	MPI_REAL, sender, 1, comm2d, &
1777	status, ierr )
1778	total_2d(ind(1):ind(2),ind(3):ind(4)) = &
1779	local_2d
1780	ENDIF
1781	ENDDO
1782	!
1783	!-- Relocate the local array for the next loop increment
1784	DEALLOCATE( local_2d )
1785	ALLOCATE( local_2d(nys:nyn,nzb_do:nzt_do) )
1786
1787	#if defined( __netcdf )
1788	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
1789	id_var_do2d(av,ivar), &
1790	total_2d(0:ny,nzb_do:nzt_do), &
1791	start = (/ is, 1, 1, do2d_yz_time_count(av) /), &
1792	count = (/ 1, ny+1, nzt_do-nzb_do+1, 1 /) )
1793	CALL netcdf_handle_error( 'data_output_2d', 61 )
1794	#endif
1795
1796	ELSE
1797	!
1798	!-- If the cross section resides on the PE, send the
1799	!-- local index limits, otherwise send -9999 to PE0.
1800	IF ( ( section(is,s_ind) >= nxl .AND. &
1801	section(is,s_ind) <= nxr ) .OR. &
1802	( section(is,s_ind) == -1 .AND. nxl-1 == -1 ) ) &
1803	THEN
1804	ind(1) = nys; ind(2) = nyn
1805	ind(3) = nzb_do; ind(4) = nzt_do
1806	ELSE
1807	ind(1) = -9999; ind(2) = -9999
1808	ind(3) = -9999; ind(4) = -9999
1809	ENDIF
1810	CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
1811	comm2d, ierr )
1812	!
1813	!-- If applicable, send data to PE0.
1814	IF ( ind(1) /= -9999 ) THEN
1815	CALL MPI_SEND( local_2d(nys,nzb_do), ngp, &
1816	MPI_REAL, 0, 1, comm2d, ierr )
1817	ENDIF
1818	ENDIF
1819	!
1820	!-- A barrier has to be set, because otherwise some PEs may
1821	!-- proceed too fast so that PE0 may receive wrong data on
1822	!-- tag 0
1823	CALL MPI_BARRIER( comm2d, ierr )
1824	ENDIF
1825
1826	ENDIF
1827	#else
1828	#if defined( __netcdf )
1829	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
1830	id_var_do2d(av,ivar), &
1831	local_2d(nys:nyn,nzb_do:nzt_do), &
1832	start = (/ is, 1, 1, do2d_xz_time_count(av) /), &
1833	count = (/ 1, ny+1, nzt_do-nzb_do+1, 1 /) )
1834	CALL netcdf_handle_error( 'data_output_2d', 452 )
1835	#endif
1836	#endif
1837
1838	END SELECT
1839
1840	is = is + 1
1841	ENDDO loop1
1842
1843	!
1844	!-- For parallel output, all data were collected before on a local array
1845	!-- and are written now to the netcdf file. This must be done to increase
1846	!-- the performance of the parallel output.
1847	#if defined( __netcdf )
1848	IF ( netcdf_data_format > 4 ) THEN
1849
1850	SELECT CASE ( mode )
1851
1852	CASE ( 'xy' )
1853	IF ( two_d ) THEN
1854	nis = 1
1855	two_d = .FALSE.
1856	ELSE
1857	nis = ns
1858	ENDIF
1859	!
1860	!-- Do not output redundant ghost point data except for the
1861	!-- boundaries of the total domain.
1862	! IF ( nxr == nx .AND. nyn /= ny ) THEN
1863	! nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1864	! id_var_do2d(av,ivar), &
1865	! local_2d_sections(nxl:nxr+1, &
1866	! nys:nyn,1:nis), &
1867	! start = (/ nxl+1, nys+1, 1, &
1868	! do2d_xy_time_count(av) /), &
1869	! count = (/ nxr-nxl+2, &
1870	! nyn-nys+1, nis, 1 &
1871	! /) )
1872	! ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN
1873	! nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1874	! id_var_do2d(av,ivar), &
1875	! local_2d_sections(nxl:nxr, &
1876	! nys:nyn+1,1:nis), &
1877	! start = (/ nxl+1, nys+1, 1, &
1878	! do2d_xy_time_count(av) /), &
1879	! count = (/ nxr-nxl+1, &
1880	! nyn-nys+2, nis, 1 &
1881	! /) )
1882	! ELSEIF ( nxr == nx .AND. nyn == ny ) THEN
1883	! nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1884	! id_var_do2d(av,ivar), &
1885	! local_2d_sections(nxl:nxr+1, &
1886	! nys:nyn+1,1:nis), &
1887	! start = (/ nxl+1, nys+1, 1, &
1888	! do2d_xy_time_count(av) /), &
1889	! count = (/ nxr-nxl+2, &
1890	! nyn-nys+2, nis, 1 &
1891	! /) )
1892	! ELSE
1893	nc_stat = NF90_PUT_VAR( id_set_xy(av), &
1894	id_var_do2d(av,ivar), &
1895	local_2d_sections(nxl:nxr, &
1896	nys:nyn,1:nis), &
1897	start = (/ nxl+1, nys+1, 1, &
1898	do2d_xy_time_count(av) /), &
1899	count = (/ nxr-nxl+1, &
1900	nyn-nys+1, nis, 1 &
1901	/) )
1902	! ENDIF
1903
1904	CALL netcdf_handle_error( 'data_output_2d', 55 )
1905
1906	CASE ( 'xz' )
1907	!
1908	!-- First, all PEs get the information of all cross-sections.
1909	!-- Then the data are written to the output file by all PEs
1910	!-- while NF90_COLLECTIVE is set in subroutine
1911	!-- define_netcdf_header. Although redundant information are
1912	!-- written to the output file in that case, the performance
1913	!-- is significantly better compared to the case where only
1914	!-- the first row of PEs in x-direction (myidx = 0) is given
1915	!-- the output while NF90_INDEPENDENT is set.
1916	IF ( npey /= 1 ) THEN
1917
1918	#if defined( __parallel )
1919	!
1920	!-- Distribute data over all PEs along y
1921	ngp = ( nxr-nxl+1 ) * ( nzt_do-nzb_do+1 ) * ns
1922	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
1923	CALL MPI_ALLREDUCE( local_2d_sections_l(nxl,1,nzb_do), &
1924	local_2d_sections(nxl,1,nzb_do), &
1925	ngp, MPI_REAL, MPI_SUM, comm1dy, &
1926	ierr )
1927	#else
1928	local_2d_sections = local_2d_sections_l
1929	#endif
1930	ENDIF
1931	!
1932	!-- Do not output redundant ghost point data except for the
1933	!-- boundaries of the total domain.
1934	! IF ( nxr == nx ) THEN
1935	! nc_stat = NF90_PUT_VAR( id_set_xz(av), &
1936	! id_var_do2d(av,ivar), &
1937	! local_2d_sections(nxl:nxr+1,1:ns, &
1938	! nzb_do:nzt_do), &
1939	! start = (/ nxl+1, 1, 1, &
1940	! do2d_xz_time_count(av) /), &
1941	! count = (/ nxr-nxl+2, ns, nzt_do-nzb_do+1, &
1942	! 1 /) )
1943	! ELSE
1944	nc_stat = NF90_PUT_VAR( id_set_xz(av), &
1945	id_var_do2d(av,ivar), &
1946	local_2d_sections(nxl:nxr,1:ns, &
1947	nzb_do:nzt_do), &
1948	start = (/ nxl+1, 1, 1, &
1949	do2d_xz_time_count(av) /), &
1950	count = (/ nxr-nxl+1, ns, nzt_do-nzb_do+1, &
1951	1 /) )
1952	! ENDIF
1953
1954	CALL netcdf_handle_error( 'data_output_2d', 57 )
1955
1956	CASE ( 'yz' )
1957	!
1958	!-- First, all PEs get the information of all cross-sections.
1959	!-- Then the data are written to the output file by all PEs
1960	!-- while NF90_COLLECTIVE is set in subroutine
1961	!-- define_netcdf_header. Although redundant information are
1962	!-- written to the output file in that case, the performance
1963	!-- is significantly better compared to the case where only
1964	!-- the first row of PEs in y-direction (myidy = 0) is given
1965	!-- the output while NF90_INDEPENDENT is set.
1966	IF ( npex /= 1 ) THEN
1967
1968	#if defined( __parallel )
1969	!
1970	!-- Distribute data over all PEs along x
1971	ngp = ( nyn-nys+1 ) * ( nzt-nzb + 2 ) * ns
1972	IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
1973	CALL MPI_ALLREDUCE( local_2d_sections_l(1,nys,nzb_do), &
1974	local_2d_sections(1,nys,nzb_do), &
1975	ngp, MPI_REAL, MPI_SUM, comm1dx, &
1976	ierr )
1977	#else
1978	local_2d_sections = local_2d_sections_l
1979	#endif
1980	ENDIF
1981	!
1982	!-- Do not output redundant ghost point data except for the
1983	!-- boundaries of the total domain.
1984	! IF ( nyn == ny ) THEN
1985	! nc_stat = NF90_PUT_VAR( id_set_yz(av), &
1986	! id_var_do2d(av,ivar), &
1987	! local_2d_sections(1:ns, &
1988	! nys:nyn+1,nzb_do:nzt_do), &
1989	! start = (/ 1, nys+1, 1, &
1990	! do2d_yz_time_count(av) /), &
1991	! count = (/ ns, nyn-nys+2, &
1992	! nzt_do-nzb_do+1, 1 /) )
1993	! ELSE
1994	nc_stat = NF90_PUT_VAR( id_set_yz(av), &
1995	id_var_do2d(av,ivar), &
1996	local_2d_sections(1:ns,nys:nyn, &
1997	nzb_do:nzt_do), &
1998	start = (/ 1, nys+1, 1, &
1999	do2d_yz_time_count(av) /), &
2000	count = (/ ns, nyn-nys+1, &
2001	nzt_do-nzb_do+1, 1 /) )
2002	! ENDIF
2003
2004	CALL netcdf_handle_error( 'data_output_2d', 60 )
2005
2006	CASE DEFAULT
2007	message_string = 'unknown cross-section: ' // TRIM( mode )
2008	CALL message( 'data_output_2d', 'PA0180', 1, 2, 0, 6, 0 )
2009
2010	END SELECT
2011
2012	ENDIF
2013	#endif
2014	ENDIF
2015
2016	ivar = ivar + 1
2017	l = MAX( 2, LEN_TRIM( do2d(av,ivar) ) )
2018	do2d_mode = do2d(av,ivar)(l-1:l)
2019
2020	ENDDO
2021
2022	!
2023	!-- Deallocate temporary arrays.
2024	IF ( ALLOCATED( level_z ) ) DEALLOCATE( level_z )
2025	IF ( netcdf_data_format > 4 ) THEN
2026	DEALLOCATE( local_pf, local_2d, local_2d_sections )
2027	IF( mode == 'xz' .OR. mode == 'yz' ) DEALLOCATE( local_2d_sections_l )
2028	ENDIF
2029	#if defined( __parallel )
2030	IF ( .NOT. data_output_2d_on_each_pe .AND. myid == 0 ) THEN
2031	DEALLOCATE( total_2d )
2032	ENDIF
2033	#endif
2034
2035	!
2036	!-- Close plot output file.
2037	file_id = 20 + s_ind
2038
2039	IF ( data_output_2d_on_each_pe ) THEN
2040	DO i = 0, io_blocks-1
2041	IF ( i == io_group ) THEN
2042	CALL close_file( file_id )
2043	ENDIF
2044	#if defined( __parallel )
2045	CALL MPI_BARRIER( comm2d, ierr )
2046	#endif
2047	ENDDO
2048	ELSE
2049	IF ( myid == 0 ) CALL close_file( file_id )
2050	ENDIF
2051
2052	CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
2053
2054	IF ( debug_output_timestep ) CALL debug_message( 'data_output_2d', 'end' )
2055
2056
2057	END SUBROUTINE data_output_2d

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |