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

Last change on this file since 1757 was 1746, checked in by gronemeier, 8 years ago

last commit documented

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