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

Last change on this file since 1704 was 1704, checked in by raasch, 8 years ago

last commit documented

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