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

Last change on this file since 1823 was 1823, checked in by hoffmann, 8 years ago

last commit documented

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