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

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

changes in LPM and bulk cloud microphysics

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