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

Last change on this file since 1783 was 1783, checked in by raasch, 6 years ago

NetCDF routines modularized; new parameter netcdf_deflate; further changes in the pmc

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