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

Last change on this file since 1682 was 1682, checked in by knoop, 6 years ago

Code annotations made doxygen readable

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