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

Last change on this file since 1691 was 1691, checked in by maronga, 8 years ago

various bugfixes and modifications of the atmosphere-land-surface-radiation interaction. Completely re-written routine to calculate surface fluxes (surface_layer_fluxes.f90) that replaces prandtl_fluxes. Minor formatting corrections and renamings

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