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

Last change on this file since 1551 was 1551, checked in by maronga, 7 years ago

land surface model released

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