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

Last change on this file since 1585 was 1585, checked in by maronga, 6 years ago

Added support for RRTMG radiation code

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