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

Last change on this file since 2001 was 2001, checked in by knoop, 8 years ago

last commit documented

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