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

Last change on this file since 2696 was 2696, checked in by kanani, 4 years ago

Merge of branch palm4u into trunk

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