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

Last change on this file since 1321 was 1321, checked in by raasch, 7 years ago

last commit documented

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