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

Last change on this file since 1692 was 1692, checked in by maronga, 6 years ago

last commit documented

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