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

Last change on this file since 1320 was 1320, checked in by raasch, 10 years ago

ONLY-attribute added to USE-statements,
kind-parameters added to all INTEGER and REAL declaration statements,
kinds are defined in new module kinds,
old module precision_kind is removed,
revision history before 2012 removed,
comment fields (!:) to be used for variable explanations added to all variable declaration statements

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