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

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

Do not open FORTRAN binary files in case of parallel netCDF I/O

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