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

Last change on this file since 1327 was 1327, checked in by raasch, 8 years ago

Changed:


-s real64 removed (.mrun.config.hlrnIII)
-r8 removed (.mrun.config.imuk)
deleted: .mrun.config.imuk_ice2_netcdf4 .mrun.config.imuk_hlrn

REAL constants defined as wp-kind in modules

"baroclinicity" renamed "baroclinity", "ocean version" replaced by
"ocean mode"

code parts concerning old output formats "iso2d" and "avs" removed.
netCDF is the only remaining output format.

Errors:


bugfix: duplicate error message 56 removed

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