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

Last change on this file since 4178 was 4048, checked in by knoop, 5 years ago

Moved turbulence_closure_mod calls into module_interface

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