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

Last change on this file since 1311 was 1311, checked in by heinze, 10 years ago

Bugfixes: forgotten dependency and #if clause not closed

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