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

Last change on this file since 1555 was 1555, checked in by maronga, 7 years ago

LSM output of r_a and r_s added

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