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

Last change on this file since 1354 was 1354, checked in by heinze, 7 years ago

last commit documented

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