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

Last change on this file since 1359 was 1359, checked in by hoffmann, 7 years ago

new Lagrangian particle structure integrated

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