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

Last change on this file since 1852 was 1852, checked in by hoffmann, 5 years ago

last commit documented

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