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

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

last commit documented

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