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

Last change on this file since 1552 was 1552, checked in by maronga, 7 years ago

last commit documented

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