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

Last change on this file since 1960 was 1960, checked in by suehring, 5 years ago

Separate balance equations for humidity and passive_scalar

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