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

Last change on this file since 2977 was 2963, checked in by suehring, 6 years ago

Minor revision of static input file checks, bugfix in initialization of surface-fractions in LSM; minor bugfix in initialization of albedo at window-surfaces; for clearer access of albedo and emissivity introduce index for vegetation/wall, pavement/green-wall and water/window surfaces

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