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

Last change on this file since 2000 was 2000, checked in by knoop, 5 years ago

Forced header and separation lines into 80 columns

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