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

Last change on this file since 3994 was 3994, checked in by suehring, 5 years ago

new module for diagnostic output quantities added + output of turbulence intensity

  • Property svn:keywords set to Id
File size: 97.5 KB
RevLine 
[1682]1!> @file data_output_2d.f90
[2000]2!------------------------------------------------------------------------------!
[2696]3! This file is part of the PALM model system.
[1036]4!
[2000]5! PALM is free software: you can redistribute it and/or modify it under the
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! version.
[1036]9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
[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 3994 2019-05-22 18:08:09Z suehring $
[3994]27! output of turbulence intensity added
28!
29! 3987 2019-05-22 09:52:13Z kanani
[3987]30! Introduce alternative switch for debug output during timestepping
31!
32! 3943 2019-05-02 09:50:41Z maronga
[3943]33! Added output of qsws for green roofs.
34!
35! 3885 2019-04-11 11:29:34Z kanani
[3885]36! Changes related to global restructuring of location messages and introduction
37! of additional debug messages
38!
39! 3766 2019-02-26 16:23:41Z raasch
[3766]40! unused variables removed
41!
42! 3655 2019-01-07 16:51:22Z knoop
[3646]43! Bugfix: use time_since_reference_point instead of simulated_time (relevant
44! when using wall/soil spinup)
45!
46! 3637 2018-12-20 01:51:36Z knoop
[3637]47! Implementation of the PALM module interface
48!
49! 3597 2018-12-04 08:40:18Z maronga
[3597]50! Added theta_2m
51!
52! 3589 2018-11-30 15:09:51Z suehring
[3589]53! Move the control parameter "salsa" from salsa_mod to control_parameters
54! (M. Kurppa)
55!
56! 3582 2018-11-29 19:16:36Z suehring
[3569]57! Remove fill_value from bio_data_output_2d call
58! dom_dwd_user, Schrempf:
59! Clean up of biometeorology calls,
60! remove uv exposure model code, this is now part of biometeorology_mod.
61!
62! 3554 2018-11-22 11:24:52Z gronemeier
[3554]63! - add variable description
64! - rename variable 'if' into 'ivar'
65! - removed namelist LOCAL
66! - removed variable rtext
67!
68! 3525 2018-11-14 16:06:14Z kanani
[3525]69! Changes related to clean-up of biometeorology (dom_dwd_user)
70!
71! 3467 2018-10-30 19:05:21Z suehring
[3467]72! Implementation of a new aerosol module salsa.
73!
74! 3448 2018-10-29 18:14:31Z kanani
[3448]75! Add biometeorology
76!
77! 3421 2018-10-24 18:39:32Z gronemeier
[3421]78! Renamed output variables
79!
80! 3419 2018-10-24 17:27:31Z gronemeier
[3298]81! minor formatting (kanani)
82! chem_data_output_2d subroutine added (basit)
83!
84! 3294 2018-10-01 02:37:10Z raasch
[3294]85! changes concerning modularization of ocean option
86!
87! 3274 2018-09-24 15:42:55Z knoop
[3274]88! Modularization of all bulk cloud physics code components
89!
90! 3241 2018-09-12 15:02:00Z raasch
[3241]91! unused variables removed
92!
93! 3176 2018-07-26 17:12:48Z suehring
[3176]94! Remove output of latent heat flux at urban-surfaces and set fill values
95! instead
96!
97! 3052 2018-05-31 06:11:20Z raasch
[3052]98! Do not open FORTRAN binary files in case of parallel netCDF I/O
99!
100! 3049 2018-05-29 13:52:36Z Giersch
[3045]101! Error messages revised
102!
[3049]103! 3045 2018-05-28 07:55:41Z Giersch
104! Error messages revised
105!
[3045]106! 3014 2018-05-09 08:42:38Z maronga
[3014]107! Added nzb_do and nzt_do for some modules for 2d output
108!
109! 3004 2018-04-27 12:33:25Z Giersch
[3004]110! precipitation_rate removed, case prr*_xy removed, to_be_resorted have to point
111! to ql_vp_av and not to ql_vp, allocation checks implemented (averaged data
112! will be assigned to fill values if no allocation happened so far)   
113!
114! 2963 2018-04-12 14:47:44Z suehring
[2963]115! Introduce index for vegetation/wall, pavement/green-wall and water/window
116! surfaces, for clearer access of surface fraction, albedo, emissivity, etc. .
117!
118! 2817 2018-02-19 16:32:21Z knoop
[2817]119! Preliminary gust module interface implemented
120!
121! 2805 2018-02-14 17:00:09Z suehring
[2798]122! Consider also default-type surfaces for surface temperature output.
123!
124! 2797 2018-02-08 13:24:35Z suehring
[2797]125! Enable output of ground-heat flux also at urban surfaces.
126!
127! 2743 2018-01-12 16:03:39Z suehring
[2743]128! In case of natural- and urban-type surfaces output surfaces fluxes in W/m2.
129!
130! 2742 2018-01-12 14:59:47Z suehring
[2742]131! Enable output of surface temperature
132!
133! 2735 2018-01-11 12:01:27Z suehring
[2735]134! output of r_a moved from land-surface to consider also urban-type surfaces
135!
136! 2718 2018-01-02 08:49:38Z maronga
[2716]137! Corrected "Former revisions" section
138!
139! 2696 2017-12-14 17:12:51Z kanani
140! Change in file header (GPL part)
[2696]141! Implementation of uv exposure model (FK)
142! Implementation of turbulence_closure_mod (TG)
143! Set fill values at topography grid points or e.g. non-natural-type surface
144! in case of LSM output (MS)
145!
146! 2512 2017-10-04 08:26:59Z raasch
[2512]147! upper bounds of cross section output changed from nx+1,ny+1 to nx,ny
148! no output of ghost layer data
149!
150! 2292 2017-06-20 09:51:42Z schwenkel
[2292]151! Implementation of new microphysic scheme: cloud_scheme = 'morrison'
152! includes two more prognostic equations for cloud drop concentration (nc) 
153! and cloud water content (qc).
154!
155! 2277 2017-06-12 10:47:51Z kanani
[2277]156! Removed unused variables do2d_xy_n, do2d_xz_n, do2d_yz_n
157!
158! 2233 2017-05-30 18:08:54Z suehring
[1552]159!
[2233]160! 2232 2017-05-30 17:47:52Z suehring
161! Adjustments to new surface concept
162!
163!
[2191]164! 2190 2017-03-21 12:16:43Z raasch
165! bugfix for r2031: string rho replaced by rho_ocean
166!
[2032]167! 2031 2016-10-21 15:11:58Z knoop
168! renamed variable rho to rho_ocean and rho_av to rho_ocean_av
169!
[2001]170! 2000 2016-08-20 18:09:15Z knoop
171! Forced header and separation lines into 80 columns
172!
[1981]173! 1980 2016-07-29 15:51:57Z suehring
174! Bugfix, in order to steer user-defined output, setting flag found explicitly
175! to .F.
176!
[1977]177! 1976 2016-07-27 13:28:04Z maronga
178! Output of radiation quantities is now done directly in the respective module
179!
[1973]180! 1972 2016-07-26 07:52:02Z maronga
[1976]181! Output of land surface quantities is now done directly in the respective
182! module
[1973]183!
[1961]184! 1960 2016-07-12 16:34:24Z suehring
185! Scalar surface flux added
186! Rename INTEGER variable s into s_ind, as s is already assigned to scalar
187!
[1851]188! 1849 2016-04-08 11:33:18Z hoffmann
189! precipitation_amount, precipitation_rate, prr moved to arrays_3d
190!
[1823]191! 1822 2016-04-07 07:49:42Z hoffmann
192! Output of bulk cloud physics simplified.
193!
[1789]194! 1788 2016-03-10 11:01:04Z maronga
195! Added output of z0q
196!
[1784]197! 1783 2016-03-06 18:36:17Z raasch
198! name change of netcdf routines and module + related changes
199!
[1746]200! 1745 2016-02-05 13:06:51Z gronemeier
201! Bugfix: test if time axis limit exceeds moved to point after call of check_open
202!
[1704]203! 1703 2015-11-02 12:38:44Z raasch
204! bugfix for output of single (*) xy-sections in case of parallel netcdf I/O
205!
[1702]206! 1701 2015-11-02 07:43:04Z maronga
207! Bugfix in output of RRTGM data
208!
[1692]209! 1691 2015-10-26 16:17:44Z maronga
210! Added output of Obukhov length (ol) and radiative heating rates  for RRTMG.
211! Formatting corrections.
212!
[1683]213! 1682 2015-10-07 23:56:08Z knoop
214! Code annotations made doxygen readable
215!
[1586]216! 1585 2015-04-30 07:05:52Z maronga
217! Added support for RRTMG
218!
[1556]219! 1555 2015-03-04 17:44:27Z maronga
220! Added output of r_a and r_s
221!
[1552]222! 1551 2015-03-03 14:18:16Z maronga
[1551]223! Added suppport for land surface model and radiation model output. In the course
224! of this action, the limits for vertical loops have been changed (from nzb and
225! nzt+1 to nzb_do and nzt_do, respectively in order to allow soil model output).
226! Moreover, a new vertical grid zs was introduced.
[1329]227!
[1360]228! 1359 2014-04-11 17:15:14Z hoffmann
229! New particle structure integrated.
230!
[1354]231! 1353 2014-04-08 15:21:23Z heinze
232! REAL constants provided with KIND-attribute
233!
[1329]234! 1327 2014-03-21 11:00:16Z raasch
235! parts concerning iso2d output removed,
236! -netcdf output queries
237!
[1321]238! 1320 2014-03-20 08:40:49Z raasch
[1320]239! ONLY-attribute added to USE-statements,
240! kind-parameters added to all INTEGER and REAL declaration statements,
241! kinds are defined in new module kinds,
242! revision history before 2012 removed,
243! comment fields (!:) to be used for variable explanations added to
244! all variable declaration statements
[1309]245!
[1319]246! 1318 2014-03-17 13:35:16Z raasch
247! barrier argument removed from cpu_log.
248! module interfaces removed
249!
[1312]250! 1311 2014-03-14 12:13:39Z heinze
251! bugfix: close #if defined( __netcdf )
252!
[1309]253! 1308 2014-03-13 14:58:42Z fricke
[1308]254! +local_2d_sections, local_2d_sections_l, ns
255! Check, if the limit of the time dimension is exceeded for parallel output
256! To increase the performance for parallel output, the following is done:
257! - Update of time axis is only done by PE0
258! - Cross sections are first stored on a local array and are written
259!   collectively to the output file by all PEs.
[674]260!
[1116]261! 1115 2013-03-26 18:16:16Z hoffmann
262! ql is calculated by calc_liquid_water_content
263!
[1077]264! 1076 2012-12-05 08:30:18Z hoffmann
265! Bugfix in output of ql
266!
[1066]267! 1065 2012-11-22 17:42:36Z hoffmann
268! Bugfix: Output of cross sections of ql
269!
[1054]270! 1053 2012-11-13 17:11:03Z hoffmann
271! +qr, nr, qc and cross sections
272!
[1037]273! 1036 2012-10-22 13:43:42Z raasch
274! code put under GPL (PALM 3.9)
275!
[1035]276! 1031 2012-10-19 14:35:30Z raasch
277! netCDF4 without parallel file support implemented
278!
[1008]279! 1007 2012-09-19 14:30:36Z franke
280! Bugfix: missing calculation of ql_vp added
281!
[979]282! 978 2012-08-09 08:28:32Z fricke
283! +z0h
284!
[1]285! Revision 1.1  1997/08/11 06:24:09  raasch
286! Initial revision
287!
288!
289! Description:
290! ------------
[2512]291!> Data output of cross-sections in netCDF format or binary format
292!> to be later converted to NetCDF by helper routine combine_plot_fields.
[1682]293!> Attention: The position of the sectional planes is still not always computed
294!> ---------  correctly. (zu is used always)!
[1]295!------------------------------------------------------------------------------!
[1682]296 SUBROUTINE data_output_2d( mode, av )
297 
[1]298
[3766]299    USE arrays_3d,                                                                                 &
300        ONLY:  dzw, d_exner, e, heatflux_output_conversion, p, pt, q, ql, ql_c, ql_v, s, tend, u,  &
301               v, vpt, w, waterflux_output_conversion, zu, zw
[3274]302
[1]303    USE averaging
[3274]304
305    USE basic_constants_and_equations_mod,                                     &
306        ONLY:  c_p, lv_d_cp, l_v
307
308    USE bulk_cloud_model_mod,                                                  &
[3637]309        ONLY:  bulk_cloud_model
[3274]310
[1320]311    USE control_parameters,                                                    &
[3637]312        ONLY:  data_output_2d_on_each_pe,                                      &
[3885]313               data_output_xy, data_output_xz, data_output_yz,                 &
[3987]314               debug_output_timestep,                                          &
[3885]315               do2d,                                                           &
[2277]316               do2d_xy_last_time, do2d_xy_time_count,                          &
317               do2d_xz_last_time, do2d_xz_time_count,                          &
318               do2d_yz_last_time, do2d_yz_time_count,                          &
[3637]319               ibc_uv_b, io_blocks, io_group, message_string,                  &
[1822]320               ntdim_2d_xy, ntdim_2d_xz, ntdim_2d_yz,                          &
[3646]321               psolver, section,                                               &
[3569]322               time_since_reference_point
[3274]323
[1320]324    USE cpulog,                                                                &
[3637]325        ONLY:  cpu_log, log_point
[3274]326
[3994]327    USE diagnostic_output_quantities_mod,                                      &
328        ONLY:  ti, ti_av
329
[1320]330    USE indices,                                                               &
[3241]331        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg,       &
[3004]332               nzb, nzt, wall_flags_0
[3274]333
[1320]334    USE kinds
[3274]335
[1551]336    USE land_surface_model_mod,                                                &
[3637]337        ONLY:  zs
[3274]338
[3637]339    USE module_interface,                                                      &
340        ONLY:  module_interface_data_output_2d
341
[1783]342#if defined( __netcdf )
343    USE NETCDF
344#endif
[1320]345
[1783]346    USE netcdf_interface,                                                      &
[2696]347        ONLY:  fill_value, id_set_xy, id_set_xz, id_set_yz, id_var_do2d,       &
348               id_var_time_xy, id_var_time_xz, id_var_time_yz, nc_stat,        &
349               netcdf_data_format, netcdf_handle_error
[1783]350
[1320]351    USE particle_attributes,                                                   &
[1359]352        ONLY:  grid_particles, number_of_particles, particle_advection_start,  &
353               particles, prt_count
[1320]354   
[1]355    USE pegrid
356
[2232]357    USE surface_mod,                                                           &
[2963]358        ONLY:  ind_pav_green, ind_veg_wall, ind_wat_win, surf_def_h,           &
359               surf_lsm_h, surf_usm_h
[2232]360
[2696]361    USE turbulence_closure_mod,                                                &
362        ONLY:  tcm_data_output_2d
363
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
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)
1268               
[3994]1269             CASE ( 'ti_xy', 'ti_xz', 'ti_yz' )
1270                IF ( av == 0 )  THEN
1271                   to_be_resorted => ti
1272                ELSE
1273                   IF ( .NOT. ALLOCATED( ti_av ) ) THEN
1274                      ALLOCATE( ti_av(nzb:nzt+1,nys:nyn,nxl:nxr) )
1275                      ti_av = REAL( fill_value, KIND = wp )
1276                   ENDIF
1277                   to_be_resorted => ti_av
1278                ENDIF
1279                IF ( mode == 'xy' )  level_z = zu
1280
[1]1281             CASE ( 'w_xy', 'w_xz', 'w_yz' )
[2696]1282                flag_nr = 3
[1]1283                IF ( av == 0 )  THEN
1284                   to_be_resorted => w
1285                ELSE
[3004]1286                   IF ( .NOT. ALLOCATED( w_av ) ) THEN
1287                      ALLOCATE( w_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
1288                      w_av = REAL( fill_value, KIND = wp )
1289                   ENDIF
[1]1290                   to_be_resorted => w_av
1291                ENDIF
1292                IF ( mode == 'xy' )  level_z = zw
1293
[72]1294             CASE ( 'z0*_xy' )        ! 2d-array
1295                IF ( av == 0 ) THEN
[2232]1296                   DO  m = 1, surf_def_h(0)%ns
1297                      i = surf_def_h(0)%i(m)
1298                      j = surf_def_h(0)%j(m)
[2512]1299                      local_pf(i,j,nzb+1) = surf_def_h(0)%z0(m)
[2232]1300                   ENDDO
1301                   DO  m = 1, surf_lsm_h%ns
1302                      i = surf_lsm_h%i(m)
1303                      j = surf_lsm_h%j(m)
[2512]1304                      local_pf(i,j,nzb+1) = surf_lsm_h%z0(m)
[2232]1305                   ENDDO
1306                   DO  m = 1, surf_usm_h%ns
1307                      i = surf_usm_h%i(m)
1308                      j = surf_usm_h%j(m)
[2512]1309                      local_pf(i,j,nzb+1) = surf_usm_h%z0(m)
[2232]1310                   ENDDO
[72]1311                ELSE
[3004]1312                   IF ( .NOT. ALLOCATED( z0_av ) ) THEN
1313                      ALLOCATE( z0_av(nysg:nyng,nxlg:nxrg) )
1314                      z0_av = REAL( fill_value, KIND = wp )
1315                   ENDIF
[2512]1316                   DO  i = nxl, nxr
1317                      DO  j = nys, nyn
[72]1318                         local_pf(i,j,nzb+1) =  z0_av(j,i)
1319                      ENDDO
1320                   ENDDO
1321                ENDIF
1322                resorted = .TRUE.
1323                two_d = .TRUE.
1324                level_z(nzb+1) = zu(nzb+1)
1325
[978]1326             CASE ( 'z0h*_xy' )        ! 2d-array
1327                IF ( av == 0 ) THEN
[2232]1328                   DO  m = 1, surf_def_h(0)%ns
1329                      i = surf_def_h(0)%i(m)
1330                      j = surf_def_h(0)%j(m)
[2512]1331                      local_pf(i,j,nzb+1) = surf_def_h(0)%z0h(m)
[2232]1332                   ENDDO
1333                   DO  m = 1, surf_lsm_h%ns
1334                      i = surf_lsm_h%i(m)
1335                      j = surf_lsm_h%j(m)
[2512]1336                      local_pf(i,j,nzb+1) = surf_lsm_h%z0h(m)
[2232]1337                   ENDDO
1338                   DO  m = 1, surf_usm_h%ns
1339                      i = surf_usm_h%i(m)
1340                      j = surf_usm_h%j(m)
[2512]1341                      local_pf(i,j,nzb+1) = surf_usm_h%z0h(m)
[2232]1342                   ENDDO
[978]1343                ELSE
[3004]1344                   IF ( .NOT. ALLOCATED( z0h_av ) ) THEN
1345                      ALLOCATE( z0h_av(nysg:nyng,nxlg:nxrg) )
1346                      z0h_av = REAL( fill_value, KIND = wp )
1347                   ENDIF
[2512]1348                   DO  i = nxl, nxr
1349                      DO  j = nys, nyn
[978]1350                         local_pf(i,j,nzb+1) =  z0h_av(j,i)
1351                      ENDDO
1352                   ENDDO
1353                ENDIF
1354                resorted = .TRUE.
1355                two_d = .TRUE.
1356                level_z(nzb+1) = zu(nzb+1)
1357
[1788]1358             CASE ( 'z0q*_xy' )        ! 2d-array
1359                IF ( av == 0 ) THEN
[2232]1360                   DO  m = 1, surf_def_h(0)%ns
1361                      i = surf_def_h(0)%i(m)
1362                      j = surf_def_h(0)%j(m)
[2512]1363                      local_pf(i,j,nzb+1) = surf_def_h(0)%z0q(m)
[2232]1364                   ENDDO
1365                   DO  m = 1, surf_lsm_h%ns
1366                      i = surf_lsm_h%i(m)
1367                      j = surf_lsm_h%j(m)
[2512]1368                      local_pf(i,j,nzb+1) = surf_lsm_h%z0q(m)
[2232]1369                   ENDDO
1370                   DO  m = 1, surf_usm_h%ns
1371                      i = surf_usm_h%i(m)
1372                      j = surf_usm_h%j(m)
[2512]1373                      local_pf(i,j,nzb+1) = surf_usm_h%z0q(m)
[2232]1374                   ENDDO
[1788]1375                ELSE
[3004]1376                   IF ( .NOT. ALLOCATED( z0q_av ) ) THEN
1377                      ALLOCATE( z0q_av(nysg:nyng,nxlg:nxrg) )
1378                      z0q_av = REAL( fill_value, KIND = wp )
1379                   ENDIF
[2512]1380                   DO  i = nxl, nxr
1381                      DO  j = nys, nyn
[1788]1382                         local_pf(i,j,nzb+1) =  z0q_av(j,i)
1383                      ENDDO
1384                   ENDDO
1385                ENDIF
1386                resorted = .TRUE.
1387                two_d = .TRUE.
1388                level_z(nzb+1) = zu(nzb+1)
1389
[1]1390             CASE DEFAULT
[1972]1391
[1]1392!
[3294]1393!--             Quantities of other modules
[1972]1394                IF ( .NOT. found )  THEN
[3637]1395                   CALL module_interface_data_output_2d(                       &
1396                           av, do2d(av,ivar), found, grid, mode,               &
1397                           local_pf, two_d, nzb_do, nzt_do,                    &
1398                           fill_value                                          &
1399                        )
[1972]1400                ENDIF
1401
[1]1402                resorted = .TRUE.
1403
1404                IF ( grid == 'zu' )  THEN
1405                   IF ( mode == 'xy' )  level_z = zu
1406                ELSEIF ( grid == 'zw' )  THEN
1407                   IF ( mode == 'xy' )  level_z = zw
[343]1408                ELSEIF ( grid == 'zu1' ) THEN
1409                   IF ( mode == 'xy' )  level_z(nzb+1) = zu(nzb+1)
[1551]1410                ELSEIF ( grid == 'zs' ) THEN
1411                   IF ( mode == 'xy' )  level_z = zs
[1]1412                ENDIF
1413
1414                IF ( .NOT. found )  THEN
[1320]1415                   message_string = 'no output provided for: ' //              &
[3554]1416                                    TRIM( do2d(av,ivar) )
[254]1417                   CALL message( 'data_output_2d', 'PA0181', 0, 0, 0, 6, 0 )
[1]1418                ENDIF
1419
1420          END SELECT
1421
1422!
[2696]1423!--       Resort the array to be output, if not done above. Flag topography
1424!--       grid points with fill values, using the corresponding maksing flag.
[1]1425          IF ( .NOT. resorted )  THEN
[2512]1426             DO  i = nxl, nxr
1427                DO  j = nys, nyn
[1551]1428                   DO  k = nzb_do, nzt_do
[2696]1429                      local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i),          &
1430                                               REAL( fill_value, KIND = wp ),  &
1431                                               BTEST( wall_flags_0(k,j,i),     &
1432                                                      flag_nr ) ) 
[1]1433                   ENDDO
1434                ENDDO
1435             ENDDO
1436          ENDIF
1437
1438!
1439!--       Output of the individual cross-sections, depending on the cross-
1440!--       section mode chosen.
1441          is = 1
[1960]1442   loop1: DO WHILE ( section(is,s_ind) /= -9999  .OR.  two_d )
[1]1443
1444             SELECT CASE ( mode )
1445
1446                CASE ( 'xy' )
1447!
1448!--                Determine the cross section index
1449                   IF ( two_d )  THEN
1450                      layer_xy = nzb+1
1451                   ELSE
[1960]1452                      layer_xy = section(is,s_ind)
[1]1453                   ENDIF
1454
1455!
[1551]1456!--                Exit the loop for layers beyond the data output domain
1457!--                (used for soil model)
[1691]1458                   IF ( layer_xy > nzt_do )  THEN
[1551]1459                      EXIT loop1
1460                   ENDIF
1461
1462!
[1308]1463!--                Update the netCDF xy cross section time axis.
1464!--                In case of parallel output, this is only done by PE0
1465!--                to increase the performance.
[3646]1466                   IF ( time_since_reference_point /= do2d_xy_last_time(av) )  THEN
[1308]1467                      do2d_xy_time_count(av) = do2d_xy_time_count(av) + 1
[3646]1468                      do2d_xy_last_time(av)  = time_since_reference_point
[1308]1469                      IF ( myid == 0 )  THEN
[1327]1470                         IF ( .NOT. data_output_2d_on_each_pe  &
1471                              .OR.  netcdf_data_format > 4 )   &
[493]1472                         THEN
[1]1473#if defined( __netcdf )
1474                            nc_stat = NF90_PUT_VAR( id_set_xy(av),             &
1475                                                    id_var_time_xy(av),        &
[291]1476                                             (/ time_since_reference_point /), &
[1]1477                                         start = (/ do2d_xy_time_count(av) /), &
1478                                                    count = (/ 1 /) )
[1783]1479                            CALL netcdf_handle_error( 'data_output_2d', 53 )
[1]1480#endif
1481                         ENDIF
1482                      ENDIF
1483                   ENDIF
1484!
1485!--                If required, carry out averaging along z
[1960]1486                   IF ( section(is,s_ind) == -1  .AND.  .NOT. two_d )  THEN
[1]1487
[1353]1488                      local_2d = 0.0_wp
[1]1489!
1490!--                   Carry out the averaging (all data are on the PE)
[1551]1491                      DO  k = nzb_do, nzt_do
[2512]1492                         DO  j = nys, nyn
1493                            DO  i = nxl, nxr
[1]1494                               local_2d(i,j) = local_2d(i,j) + local_pf(i,j,k)
1495                            ENDDO
1496                         ENDDO
1497                      ENDDO
1498
[1551]1499                      local_2d = local_2d / ( nzt_do - nzb_do + 1.0_wp)
[1]1500
1501                   ELSE
1502!
1503!--                   Just store the respective section on the local array
1504                      local_2d = local_pf(:,:,layer_xy)
1505
1506                   ENDIF
1507
1508#if defined( __parallel )
[1327]1509                   IF ( netcdf_data_format > 4 )  THEN
[1]1510!
[1031]1511!--                   Parallel output in netCDF4/HDF5 format.
[493]1512                      IF ( two_d ) THEN
1513                         iis = 1
1514                      ELSE
1515                         iis = is
1516                      ENDIF
1517
[1]1518#if defined( __netcdf )
[1308]1519!
1520!--                   For parallel output, all cross sections are first stored
1521!--                   here on a local array and will be written to the output
1522!--                   file afterwards to increase the performance.
[2512]1523                      DO  i = nxl, nxr
1524                         DO  j = nys, nyn
[1308]1525                            local_2d_sections(i,j,iis) = local_2d(i,j)
1526                         ENDDO
1527                      ENDDO
[1]1528#endif
[493]1529                   ELSE
[1]1530
[493]1531                      IF ( data_output_2d_on_each_pe )  THEN
[1]1532!
[493]1533!--                      Output of partial arrays on each PE
1534#if defined( __netcdf )
[1327]1535                         IF ( myid == 0 )  THEN
[1320]1536                            WRITE ( 21 )  time_since_reference_point,          &
[493]1537                                          do2d_xy_time_count(av), av
1538                         ENDIF
1539#endif
[759]1540                         DO  i = 0, io_blocks-1
1541                            IF ( i == io_group )  THEN
[2512]1542                               WRITE ( 21 )  nxl, nxr, nys, nyn, nys, nyn
[759]1543                               WRITE ( 21 )  local_2d
1544                            ENDIF
1545#if defined( __parallel )
1546                            CALL MPI_BARRIER( comm2d, ierr )
1547#endif
1548                         ENDDO
[559]1549
[493]1550                      ELSE
[1]1551!
[493]1552!--                      PE0 receives partial arrays from all processors and
1553!--                      then outputs them. Here a barrier has to be set,
1554!--                      because otherwise "-MPI- FATAL: Remote protocol queue
1555!--                      full" may occur.
1556                         CALL MPI_BARRIER( comm2d, ierr )
1557
[2512]1558                         ngp = ( nxr-nxl+1 ) * ( nyn-nys+1 )
[493]1559                         IF ( myid == 0 )  THEN
[1]1560!
[493]1561!--                         Local array can be relocated directly.
[2512]1562                            total_2d(nxl:nxr,nys:nyn) = local_2d
[1]1563!
[493]1564!--                         Receive data from all other PEs.
1565                            DO  n = 1, numprocs-1
[1]1566!
[493]1567!--                            Receive index limits first, then array.
1568!--                            Index limits are received in arbitrary order from
1569!--                            the PEs.
[1320]1570                               CALL MPI_RECV( ind(1), 4, MPI_INTEGER,          &
1571                                              MPI_ANY_SOURCE, 0, comm2d,       &
[493]1572                                              status, ierr )
1573                               sender = status(MPI_SOURCE)
1574                               DEALLOCATE( local_2d )
1575                               ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
[1320]1576                               CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp,    &
1577                                              MPI_REAL, sender, 1, comm2d,     &
[493]1578                                              status, ierr )
1579                               total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
1580                            ENDDO
[1]1581!
[493]1582!--                         Relocate the local array for the next loop increment
1583                            DEALLOCATE( local_2d )
[2512]1584                            ALLOCATE( local_2d(nxl:nxr,nys:nyn) )
[1]1585
1586#if defined( __netcdf )
[1327]1587                            IF ( two_d ) THEN
1588                               nc_stat = NF90_PUT_VAR( id_set_xy(av),       &
[3554]1589                                                       id_var_do2d(av,ivar),  &
[2512]1590                                                       total_2d(0:nx,0:ny), &
[1327]1591                             start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
[2512]1592                                             count = (/ nx+1, ny+1, 1, 1 /) )
[1327]1593                            ELSE
1594                               nc_stat = NF90_PUT_VAR( id_set_xy(av),       &
[3554]1595                                                       id_var_do2d(av,ivar),  &
[2512]1596                                                       total_2d(0:nx,0:ny), &
[1327]1597                            start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
[2512]1598                                             count = (/ nx+1, ny+1, 1, 1 /) )
[1]1599                            ENDIF
[1783]1600                            CALL netcdf_handle_error( 'data_output_2d', 54 )
[1]1601#endif
1602
[493]1603                         ELSE
[1]1604!
[493]1605!--                         First send the local index limits to PE0
[2512]1606                            ind(1) = nxl; ind(2) = nxr
1607                            ind(3) = nys; ind(4) = nyn
[1320]1608                            CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0,       &
[493]1609                                           comm2d, ierr )
[1]1610!
[493]1611!--                         Send data to PE0
[2512]1612                            CALL MPI_SEND( local_2d(nxl,nys), ngp,             &
[493]1613                                           MPI_REAL, 0, 1, comm2d, ierr )
1614                         ENDIF
1615!
1616!--                      A barrier has to be set, because otherwise some PEs may
1617!--                      proceed too fast so that PE0 may receive wrong data on
1618!--                      tag 0
1619                         CALL MPI_BARRIER( comm2d, ierr )
[1]1620                      ENDIF
[493]1621
[1]1622                   ENDIF
1623#else
1624#if defined( __netcdf )
[1327]1625                   IF ( two_d ) THEN
1626                      nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
[3554]1627                                              id_var_do2d(av,ivar),           &
[2512]1628                                              local_2d(nxl:nxr,nys:nyn),    &
[1327]1629                             start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
[2512]1630                                           count = (/ nx+1, ny+1, 1, 1 /) )
[1327]1631                   ELSE
1632                      nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
[3554]1633                                              id_var_do2d(av,ivar),           &
[2512]1634                                              local_2d(nxl:nxr,nys:nyn),    &
[1327]1635                            start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
[2512]1636                                           count = (/ nx+1, ny+1, 1, 1 /) )
[1]1637                   ENDIF
[1783]1638                   CALL netcdf_handle_error( 'data_output_2d', 447 )
[1]1639#endif
1640#endif
[2277]1641
[1]1642!
1643!--                For 2D-arrays (e.g. u*) only one cross-section is available.
1644!--                Hence exit loop of output levels.
1645                   IF ( two_d )  THEN
[1703]1646                      IF ( netcdf_data_format < 5 )  two_d = .FALSE.
[1]1647                      EXIT loop1
1648                   ENDIF
1649
1650                CASE ( 'xz' )
1651!
[1308]1652!--                Update the netCDF xz cross section time axis.
1653!--                In case of parallel output, this is only done by PE0
1654!--                to increase the performance.
[3646]1655                   IF ( time_since_reference_point /= do2d_xz_last_time(av) )  THEN
[1308]1656                      do2d_xz_time_count(av) = do2d_xz_time_count(av) + 1
[3646]1657                      do2d_xz_last_time(av)  = time_since_reference_point
[1308]1658                      IF ( myid == 0 )  THEN
[1327]1659                         IF ( .NOT. data_output_2d_on_each_pe  &
1660                              .OR.  netcdf_data_format > 4 )   &
[493]1661                         THEN
[1]1662#if defined( __netcdf )
1663                            nc_stat = NF90_PUT_VAR( id_set_xz(av),             &
1664                                                    id_var_time_xz(av),        &
[291]1665                                             (/ time_since_reference_point /), &
[1]1666                                         start = (/ do2d_xz_time_count(av) /), &
1667                                                    count = (/ 1 /) )
[1783]1668                            CALL netcdf_handle_error( 'data_output_2d', 56 )
[1]1669#endif
1670                         ENDIF
1671                      ENDIF
1672                   ENDIF
[667]1673
[1]1674!
1675!--                If required, carry out averaging along y
[1960]1676                   IF ( section(is,s_ind) == -1 )  THEN
[1]1677
[2512]1678                      ALLOCATE( local_2d_l(nxl:nxr,nzb_do:nzt_do) )
[1353]1679                      local_2d_l = 0.0_wp
[2512]1680                      ngp = ( nxr-nxl + 1 ) * ( nzt_do-nzb_do + 1 )
[1]1681!
1682!--                   First local averaging on the PE
[1551]1683                      DO  k = nzb_do, nzt_do
[1]1684                         DO  j = nys, nyn
[2512]1685                            DO  i = nxl, nxr
[1320]1686                               local_2d_l(i,k) = local_2d_l(i,k) +             &
[1]1687                                                 local_pf(i,j,k)
1688                            ENDDO
1689                         ENDDO
1690                      ENDDO
1691#if defined( __parallel )
1692!
1693!--                   Now do the averaging over all PEs along y
[622]1694                      IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
[2512]1695                      CALL MPI_ALLREDUCE( local_2d_l(nxl,nzb_do),                &
1696                                          local_2d(nxl,nzb_do), ngp, MPI_REAL,   &
[1]1697                                          MPI_SUM, comm1dy, ierr )
1698#else
1699                      local_2d = local_2d_l
1700#endif
[1353]1701                      local_2d = local_2d / ( ny + 1.0_wp )
[1]1702
1703                      DEALLOCATE( local_2d_l )
1704
1705                   ELSE
1706!
1707!--                   Just store the respective section on the local array
1708!--                   (but only if it is available on this PE!)
[1960]1709                      IF ( section(is,s_ind) >= nys  .AND.  section(is,s_ind) <= nyn ) &
[1]1710                      THEN
[1960]1711                         local_2d = local_pf(:,section(is,s_ind),nzb_do:nzt_do)
[1]1712                      ENDIF
1713
1714                   ENDIF
1715
1716#if defined( __parallel )
[1327]1717                   IF ( netcdf_data_format > 4 )  THEN
[1]1718!
[1031]1719!--                   Output in netCDF4/HDF5 format.
[493]1720!--                   Output only on those PEs where the respective cross
1721!--                   sections reside. Cross sections averaged along y are
1722!--                   output on the respective first PE along y (myidy=0).
[1960]1723                      IF ( ( section(is,s_ind) >= nys  .AND.                   &
1724                             section(is,s_ind) <= nyn )  .OR.                  &
1725                           ( section(is,s_ind) == -1  .AND.  myidy == 0 ) )  THEN
[1]1726#if defined( __netcdf )
[493]1727!
[1308]1728!--                      For parallel output, all cross sections are first
1729!--                      stored here on a local array and will be written to the
1730!--                      output file afterwards to increase the performance.
[2512]1731                         DO  i = nxl, nxr
[1551]1732                            DO  k = nzb_do, nzt_do
[1308]1733                               local_2d_sections_l(i,is,k) = local_2d(i,k)
1734                            ENDDO
1735                         ENDDO
[1]1736#endif
1737                      ENDIF
1738
1739                   ELSE
1740
[493]1741                      IF ( data_output_2d_on_each_pe )  THEN
[1]1742!
[493]1743!--                      Output of partial arrays on each PE. If the cross
1744!--                      section does not reside on the PE, output special
1745!--                      index values.
1746#if defined( __netcdf )
[1327]1747                         IF ( myid == 0 )  THEN
[1320]1748                            WRITE ( 22 )  time_since_reference_point,          &
[493]1749                                          do2d_xz_time_count(av), av
1750                         ENDIF
1751#endif
[759]1752                         DO  i = 0, io_blocks-1
1753                            IF ( i == io_group )  THEN
[1960]1754                               IF ( ( section(is,s_ind) >= nys  .AND.          &
1755                                      section(is,s_ind) <= nyn )  .OR.         &
1756                                    ( section(is,s_ind) == -1  .AND.           &
[1320]1757                                      nys-1 == -1 ) )                          &
[759]1758                               THEN
[2512]1759                                  WRITE (22)  nxl, nxr, nzb_do, nzt_do, nzb, nzt+1
[759]1760                                  WRITE (22)  local_2d
1761                               ELSE
[1551]1762                                  WRITE (22)  -1, -1, -1, -1, -1, -1
[759]1763                               ENDIF
1764                            ENDIF
1765#if defined( __parallel )
1766                            CALL MPI_BARRIER( comm2d, ierr )
1767#endif
1768                         ENDDO
[493]1769
1770                      ELSE
[1]1771!
[493]1772!--                      PE0 receives partial arrays from all processors of the
1773!--                      respective cross section and outputs them. Here a
1774!--                      barrier has to be set, because otherwise
1775!--                      "-MPI- FATAL: Remote protocol queue full" may occur.
1776                         CALL MPI_BARRIER( comm2d, ierr )
1777
[2512]1778                         ngp = ( nxr-nxl + 1 ) * ( nzt_do-nzb_do + 1 )
[493]1779                         IF ( myid == 0 )  THEN
[1]1780!
[493]1781!--                         Local array can be relocated directly.
[1960]1782                            IF ( ( section(is,s_ind) >= nys  .AND.              &
1783                                   section(is,s_ind) <= nyn )  .OR.             &
1784                                 ( section(is,s_ind) == -1  .AND.               &
1785                                   nys-1 == -1 ) )  THEN
[2512]1786                               total_2d(nxl:nxr,nzb_do:nzt_do) = local_2d
[493]1787                            ENDIF
[1]1788!
[493]1789!--                         Receive data from all other PEs.
1790                            DO  n = 1, numprocs-1
1791!
1792!--                            Receive index limits first, then array.
1793!--                            Index limits are received in arbitrary order from
1794!--                            the PEs.
[1320]1795                               CALL MPI_RECV( ind(1), 4, MPI_INTEGER,          &
1796                                              MPI_ANY_SOURCE, 0, comm2d,       &
[1]1797                                              status, ierr )
[493]1798!
1799!--                            Not all PEs have data for XZ-cross-section.
1800                               IF ( ind(1) /= -9999 )  THEN
1801                                  sender = status(MPI_SOURCE)
1802                                  DEALLOCATE( local_2d )
[1320]1803                                  ALLOCATE( local_2d(ind(1):ind(2),            &
[493]1804                                                     ind(3):ind(4)) )
1805                                  CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
1806                                                 MPI_REAL, sender, 1, comm2d,  &
1807                                                 status, ierr )
[1320]1808                                  total_2d(ind(1):ind(2),ind(3):ind(4)) =      &
[493]1809                                                                        local_2d
1810                               ENDIF
1811                            ENDDO
1812!
1813!--                         Relocate the local array for the next loop increment
1814                            DEALLOCATE( local_2d )
[2512]1815                            ALLOCATE( local_2d(nxl:nxr,nzb_do:nzt_do) )
[1]1816
1817#if defined( __netcdf )
[2512]1818                            nc_stat = NF90_PUT_VAR( id_set_xz(av),             &
[3554]1819                                                 id_var_do2d(av,ivar),           &
[2512]1820                                                 total_2d(0:nx,nzb_do:nzt_do), &
1821                               start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
1822                                          count = (/ nx+1, 1, nzt_do-nzb_do+1, 1 /) )
[1783]1823                            CALL netcdf_handle_error( 'data_output_2d', 58 )
[1]1824#endif
1825
[493]1826                         ELSE
[1]1827!
[493]1828!--                         If the cross section resides on the PE, send the
1829!--                         local index limits, otherwise send -9999 to PE0.
[1960]1830                            IF ( ( section(is,s_ind) >= nys  .AND.              &
1831                                   section(is,s_ind) <= nyn )  .OR.             &
1832                                 ( section(is,s_ind) == -1  .AND.  nys-1 == -1 ) ) &
[493]1833                            THEN
[2512]1834                               ind(1) = nxl; ind(2) = nxr
[1551]1835                               ind(3) = nzb_do;   ind(4) = nzt_do
[493]1836                            ELSE
1837                               ind(1) = -9999; ind(2) = -9999
1838                               ind(3) = -9999; ind(4) = -9999
1839                            ENDIF
[1320]1840                            CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0,       &
[493]1841                                           comm2d, ierr )
1842!
1843!--                         If applicable, send data to PE0.
1844                            IF ( ind(1) /= -9999 )  THEN
[2512]1845                               CALL MPI_SEND( local_2d(nxl,nzb_do), ngp,         &
[493]1846                                              MPI_REAL, 0, 1, comm2d, ierr )
1847                            ENDIF
[1]1848                         ENDIF
1849!
[493]1850!--                      A barrier has to be set, because otherwise some PEs may
1851!--                      proceed too fast so that PE0 may receive wrong data on
1852!--                      tag 0
1853                         CALL MPI_BARRIER( comm2d, ierr )
[1]1854                      ENDIF
[493]1855
[1]1856                   ENDIF
1857#else
1858#if defined( __netcdf )
[1327]1859                   nc_stat = NF90_PUT_VAR( id_set_xz(av),                   &
[3554]1860                                           id_var_do2d(av,ivar),              &
[2512]1861                                           local_2d(nxl:nxr,nzb_do:nzt_do), &
[1327]1862                            start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
[2512]1863                                       count = (/ nx+1, 1, nzt_do-nzb_do+1, 1 /) )
[1783]1864                   CALL netcdf_handle_error( 'data_output_2d', 451 )
[1]1865#endif
1866#endif
1867
1868                CASE ( 'yz' )
1869!
[1308]1870!--                Update the netCDF yz cross section time axis.
1871!--                In case of parallel output, this is only done by PE0
1872!--                to increase the performance.
[3646]1873                   IF ( time_since_reference_point /= do2d_yz_last_time(av) )  THEN
[1308]1874                      do2d_yz_time_count(av) = do2d_yz_time_count(av) + 1
[3646]1875                      do2d_yz_last_time(av)  = time_since_reference_point
[1308]1876                      IF ( myid == 0 )  THEN
[1327]1877                         IF ( .NOT. data_output_2d_on_each_pe  &
1878                              .OR.  netcdf_data_format > 4 )   &
[493]1879                         THEN
[1]1880#if defined( __netcdf )
1881                            nc_stat = NF90_PUT_VAR( id_set_yz(av),             &
1882                                                    id_var_time_yz(av),        &
[291]1883                                             (/ time_since_reference_point /), &
[1]1884                                         start = (/ do2d_yz_time_count(av) /), &
1885                                                    count = (/ 1 /) )
[1783]1886                            CALL netcdf_handle_error( 'data_output_2d', 59 )
[1]1887#endif
1888                         ENDIF
1889                      ENDIF
[1308]1890                   ENDIF
[493]1891
[1]1892!
1893!--                If required, carry out averaging along x
[1960]1894                   IF ( section(is,s_ind) == -1 )  THEN
[1]1895
[2512]1896                      ALLOCATE( local_2d_l(nys:nyn,nzb_do:nzt_do) )
[1353]1897                      local_2d_l = 0.0_wp
[2512]1898                      ngp = ( nyn-nys+1 ) * ( nzt_do-nzb_do+1 )
[1]1899!
1900!--                   First local averaging on the PE
[1551]1901                      DO  k = nzb_do, nzt_do
[2512]1902                         DO  j = nys, nyn
[1]1903                            DO  i = nxl, nxr
[1320]1904                               local_2d_l(j,k) = local_2d_l(j,k) +             &
[1]1905                                                 local_pf(i,j,k)
1906                            ENDDO
1907                         ENDDO
1908                      ENDDO
1909#if defined( __parallel )
1910!
1911!--                   Now do the averaging over all PEs along x
[622]1912                      IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
[2512]1913                      CALL MPI_ALLREDUCE( local_2d_l(nys,nzb_do),                &
1914                                          local_2d(nys,nzb_do), ngp, MPI_REAL,   &
[1]1915                                          MPI_SUM, comm1dx, ierr )
1916#else
1917                      local_2d = local_2d_l
1918#endif
[1353]1919                      local_2d = local_2d / ( nx + 1.0_wp )
[1]1920
1921                      DEALLOCATE( local_2d_l )
1922
1923                   ELSE
1924!
1925!--                   Just store the respective section on the local array
1926!--                   (but only if it is available on this PE!)
[1960]1927                      IF ( section(is,s_ind) >= nxl  .AND.  section(is,s_ind) <= nxr ) &
[1]1928                      THEN
[1960]1929                         local_2d = local_pf(section(is,s_ind),:,nzb_do:nzt_do)
[1]1930                      ENDIF
1931
1932                   ENDIF
1933
1934#if defined( __parallel )
[1327]1935                   IF ( netcdf_data_format > 4 )  THEN
[1]1936!
[1031]1937!--                   Output in netCDF4/HDF5 format.
[493]1938!--                   Output only on those PEs where the respective cross
1939!--                   sections reside. Cross sections averaged along x are
1940!--                   output on the respective first PE along x (myidx=0).
[1960]1941                      IF ( ( section(is,s_ind) >= nxl  .AND.                       &
1942                             section(is,s_ind) <= nxr )  .OR.                      &
1943                           ( section(is,s_ind) == -1  .AND.  myidx == 0 ) )  THEN
[1]1944#if defined( __netcdf )
[493]1945!
[1308]1946!--                      For parallel output, all cross sections are first
1947!--                      stored here on a local array and will be written to the
1948!--                      output file afterwards to increase the performance.
[2512]1949                         DO  j = nys, nyn
[1551]1950                            DO  k = nzb_do, nzt_do
[1308]1951                               local_2d_sections_l(is,j,k) = local_2d(j,k)
1952                            ENDDO
1953                         ENDDO
[1]1954#endif
1955                      ENDIF
1956
1957                   ELSE
1958
[493]1959                      IF ( data_output_2d_on_each_pe )  THEN
[1]1960!
[493]1961!--                      Output of partial arrays on each PE. If the cross
1962!--                      section does not reside on the PE, output special
1963!--                      index values.
1964#if defined( __netcdf )
[1327]1965                         IF ( myid == 0 )  THEN
[1320]1966                            WRITE ( 23 )  time_since_reference_point,          &
[493]1967                                          do2d_yz_time_count(av), av
1968                         ENDIF
1969#endif
[759]1970                         DO  i = 0, io_blocks-1
1971                            IF ( i == io_group )  THEN
[1960]1972                               IF ( ( section(is,s_ind) >= nxl  .AND.          &
1973                                      section(is,s_ind) <= nxr )  .OR.         &
1974                                    ( section(is,s_ind) == -1  .AND.           &
[1320]1975                                      nxl-1 == -1 ) )                          &
[759]1976                               THEN
[2512]1977                                  WRITE (23)  nys, nyn, nzb_do, nzt_do, nzb, nzt+1
[759]1978                                  WRITE (23)  local_2d
1979                               ELSE
[1551]1980                                  WRITE (23)  -1, -1, -1, -1, -1, -1
[759]1981                               ENDIF
1982                            ENDIF
1983#if defined( __parallel )
1984                            CALL MPI_BARRIER( comm2d, ierr )
1985#endif
1986                         ENDDO
[493]1987
1988                      ELSE
[1]1989!
[493]1990!--                      PE0 receives partial arrays from all processors of the
1991!--                      respective cross section and outputs them. Here a
1992!--                      barrier has to be set, because otherwise
1993!--                      "-MPI- FATAL: Remote protocol queue full" may occur.
1994                         CALL MPI_BARRIER( comm2d, ierr )
1995
[2512]1996                         ngp = ( nyn-nys+1 ) * ( nzt_do-nzb_do+1 )
[493]1997                         IF ( myid == 0 )  THEN
[1]1998!
[493]1999!--                         Local array can be relocated directly.
[1960]2000                            IF ( ( section(is,s_ind) >= nxl  .AND.             &
2001                                   section(is,s_ind) <= nxr )   .OR.           &
2002                                 ( section(is,s_ind) == -1  .AND.  nxl-1 == -1 ) ) &
[493]2003                            THEN
[2512]2004                               total_2d(nys:nyn,nzb_do:nzt_do) = local_2d
[493]2005                            ENDIF
[1]2006!
[493]2007!--                         Receive data from all other PEs.
2008                            DO  n = 1, numprocs-1
2009!
2010!--                            Receive index limits first, then array.
2011!--                            Index limits are received in arbitrary order from
2012!--                            the PEs.
[1320]2013                               CALL MPI_RECV( ind(1), 4, MPI_INTEGER,          &
2014                                              MPI_ANY_SOURCE, 0, comm2d,       &
[1]2015                                              status, ierr )
[493]2016!
2017!--                            Not all PEs have data for YZ-cross-section.
2018                               IF ( ind(1) /= -9999 )  THEN
2019                                  sender = status(MPI_SOURCE)
2020                                  DEALLOCATE( local_2d )
[1320]2021                                  ALLOCATE( local_2d(ind(1):ind(2),            &
[493]2022                                                     ind(3):ind(4)) )
2023                                  CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
2024                                                 MPI_REAL, sender, 1, comm2d,  &
2025                                                 status, ierr )
[1320]2026                                  total_2d(ind(1):ind(2),ind(3):ind(4)) =      &
[493]2027                                                                        local_2d
2028                               ENDIF
2029                            ENDDO
2030!
2031!--                         Relocate the local array for the next loop increment
2032                            DEALLOCATE( local_2d )
[2512]2033                            ALLOCATE( local_2d(nys:nyn,nzb_do:nzt_do) )
[1]2034
2035#if defined( __netcdf )
[2512]2036                            nc_stat = NF90_PUT_VAR( id_set_yz(av),             &
[3554]2037                                                 id_var_do2d(av,ivar),           &
[2512]2038                                                 total_2d(0:ny,nzb_do:nzt_do), &
2039                            start = (/ is, 1, 1, do2d_yz_time_count(av) /),    &
2040                                       count = (/ 1, ny+1, nzt_do-nzb_do+1, 1 /) )
[1783]2041                            CALL netcdf_handle_error( 'data_output_2d', 61 )
[1]2042#endif
2043
[493]2044                         ELSE
[1]2045!
[493]2046!--                         If the cross section resides on the PE, send the
2047!--                         local index limits, otherwise send -9999 to PE0.
[1960]2048                            IF ( ( section(is,s_ind) >= nxl  .AND.              &
2049                                   section(is,s_ind) <= nxr )  .OR.             &
2050                                 ( section(is,s_ind) == -1  .AND.  nxl-1 == -1 ) ) &
[493]2051                            THEN
[2512]2052                               ind(1) = nys; ind(2) = nyn
[1551]2053                               ind(3) = nzb_do;   ind(4) = nzt_do
[493]2054                            ELSE
2055                               ind(1) = -9999; ind(2) = -9999
2056                               ind(3) = -9999; ind(4) = -9999
2057                            ENDIF
[1320]2058                            CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0,       &
[493]2059                                           comm2d, ierr )
2060!
2061!--                         If applicable, send data to PE0.
2062                            IF ( ind(1) /= -9999 )  THEN
[2512]2063                               CALL MPI_SEND( local_2d(nys,nzb_do), ngp,         &
[493]2064                                              MPI_REAL, 0, 1, comm2d, ierr )
2065                            ENDIF
[1]2066                         ENDIF
2067!
[493]2068!--                      A barrier has to be set, because otherwise some PEs may
2069!--                      proceed too fast so that PE0 may receive wrong data on
2070!--                      tag 0
2071                         CALL MPI_BARRIER( comm2d, ierr )
[1]2072                      ENDIF
[493]2073
[1]2074                   ENDIF
2075#else
2076#if defined( __netcdf )
[1327]2077                   nc_stat = NF90_PUT_VAR( id_set_yz(av),                   &
[3554]2078                                           id_var_do2d(av,ivar),              &
[2512]2079                                           local_2d(nys:nyn,nzb_do:nzt_do), &
[1327]2080                            start = (/ is, 1, 1, do2d_xz_time_count(av) /), &
[2512]2081                                           count = (/ 1, ny+1, nzt_do-nzb_do+1, 1 /) )
[1783]2082                   CALL netcdf_handle_error( 'data_output_2d', 452 )
[1]2083#endif
2084#endif
2085
2086             END SELECT
2087
2088             is = is + 1
2089          ENDDO loop1
2090
[1308]2091!
2092!--       For parallel output, all data were collected before on a local array
2093!--       and are written now to the netcdf file. This must be done to increase
2094!--       the performance of the parallel output.
2095#if defined( __netcdf )
[1327]2096          IF ( netcdf_data_format > 4 )  THEN
[1308]2097
2098                SELECT CASE ( mode )
2099
2100                   CASE ( 'xy' )
2101                      IF ( two_d ) THEN
[1703]2102                         nis = 1
2103                         two_d = .FALSE.
[1308]2104                      ELSE
[1703]2105                         nis = ns
[1308]2106                      ENDIF
2107!
2108!--                   Do not output redundant ghost point data except for the
2109!--                   boundaries of the total domain.
[2512]2110!                      IF ( nxr == nx  .AND.  nyn /= ny )  THEN
2111!                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
[3554]2112!                                                 id_var_do2d(av,ivar),           &
[2512]2113!                                                 local_2d_sections(nxl:nxr+1,  &
2114!                                                    nys:nyn,1:nis),            &
2115!                                                 start = (/ nxl+1, nys+1, 1,   &
2116!                                                    do2d_xy_time_count(av) /), &
2117!                                                 count = (/ nxr-nxl+2,         &
2118!                                                            nyn-nys+1, nis, 1  &
2119!                                                          /) )
2120!                      ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
2121!                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
[3554]2122!                                                 id_var_do2d(av,ivar),           &
[2512]2123!                                                 local_2d_sections(nxl:nxr,    &
2124!                                                    nys:nyn+1,1:nis),          &
2125!                                                 start = (/ nxl+1, nys+1, 1,   &
2126!                                                    do2d_xy_time_count(av) /), &
2127!                                                 count = (/ nxr-nxl+1,         &
2128!                                                            nyn-nys+2, nis, 1  &
2129!                                                          /) )
2130!                      ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
2131!                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
[3554]2132!                                                 id_var_do2d(av,ivar),           &
[2512]2133!                                                 local_2d_sections(nxl:nxr+1,  &
2134!                                                    nys:nyn+1,1:nis),          &
2135!                                                 start = (/ nxl+1, nys+1, 1,   &
2136!                                                    do2d_xy_time_count(av) /), &
2137!                                                 count = (/ nxr-nxl+2,         &
2138!                                                            nyn-nys+2, nis, 1  &
2139!                                                          /) )
2140!                      ELSE
[1308]2141                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
[3554]2142                                                 id_var_do2d(av,ivar),           &
[1308]2143                                                 local_2d_sections(nxl:nxr,    &
[1703]2144                                                    nys:nyn,1:nis),            &
[1308]2145                                                 start = (/ nxl+1, nys+1, 1,   &
2146                                                    do2d_xy_time_count(av) /), &
2147                                                 count = (/ nxr-nxl+1,         &
[1703]2148                                                            nyn-nys+1, nis, 1  &
[1308]2149                                                          /) )
[2512]2150!                      ENDIF   
[1308]2151
[1783]2152                      CALL netcdf_handle_error( 'data_output_2d', 55 )
[1308]2153
2154                   CASE ( 'xz' )
2155!
2156!--                   First, all PEs get the information of all cross-sections.
2157!--                   Then the data are written to the output file by all PEs
2158!--                   while NF90_COLLECTIVE is set in subroutine
2159!--                   define_netcdf_header. Although redundant information are
2160!--                   written to the output file in that case, the performance
2161!--                   is significantly better compared to the case where only
2162!--                   the first row of PEs in x-direction (myidx = 0) is given
2163!--                   the output while NF90_INDEPENDENT is set.
2164                      IF ( npey /= 1 )  THEN
2165                         
2166#if defined( __parallel )
2167!
2168!--                      Distribute data over all PEs along y
[2512]2169                         ngp = ( nxr-nxl+1 ) * ( nzt_do-nzb_do+1 ) * ns
[1308]2170                         IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
[2512]2171                         CALL MPI_ALLREDUCE( local_2d_sections_l(nxl,1,nzb_do),  &
2172                                             local_2d_sections(nxl,1,nzb_do),    &
[1308]2173                                             ngp, MPI_REAL, MPI_SUM, comm1dy,  &
2174                                             ierr )
2175#else
2176                         local_2d_sections = local_2d_sections_l
2177#endif
2178                      ENDIF
2179!
2180!--                   Do not output redundant ghost point data except for the
2181!--                   boundaries of the total domain.
[2512]2182!                      IF ( nxr == nx )  THEN
2183!                         nc_stat = NF90_PUT_VAR( id_set_xz(av),                &
[3554]2184!                                             id_var_do2d(av,ivar),               &
[2512]2185!                                             local_2d_sections(nxl:nxr+1,1:ns, &
2186!                                                nzb_do:nzt_do),                &
2187!                                             start = (/ nxl+1, 1, 1,           &
2188!                                                do2d_xz_time_count(av) /),     &
2189!                                             count = (/ nxr-nxl+2, ns, nzt_do-nzb_do+1,  &
2190!                                                        1 /) )
2191!                      ELSE
[1308]2192                         nc_stat = NF90_PUT_VAR( id_set_xz(av),                &
[3554]2193                                             id_var_do2d(av,ivar),               &
[1308]2194                                             local_2d_sections(nxl:nxr,1:ns,   &
[1551]2195                                                nzb_do:nzt_do),                &
[1308]2196                                             start = (/ nxl+1, 1, 1,           &
2197                                                do2d_xz_time_count(av) /),     &
[1551]2198                                             count = (/ nxr-nxl+1, ns, nzt_do-nzb_do+1,  &
[1308]2199                                                1 /) )
[2512]2200!                      ENDIF
[1308]2201
[1783]2202                      CALL netcdf_handle_error( 'data_output_2d', 57 )
[1308]2203
2204                   CASE ( 'yz' )
2205!
2206!--                   First, all PEs get the information of all cross-sections.
2207!--                   Then the data are written to the output file by all PEs
2208!--                   while NF90_COLLECTIVE is set in subroutine
2209!--                   define_netcdf_header. Although redundant information are
2210!--                   written to the output file in that case, the performance
2211!--                   is significantly better compared to the case where only
2212!--                   the first row of PEs in y-direction (myidy = 0) is given
2213!--                   the output while NF90_INDEPENDENT is set.
2214                      IF ( npex /= 1 )  THEN
2215
2216#if defined( __parallel )
2217!
2218!--                      Distribute data over all PEs along x
[2512]2219                         ngp = ( nyn-nys+1 ) * ( nzt-nzb + 2 ) * ns
[1308]2220                         IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
[2512]2221                         CALL MPI_ALLREDUCE( local_2d_sections_l(1,nys,nzb_do),  &
2222                                             local_2d_sections(1,nys,nzb_do),    &
[1308]2223                                             ngp, MPI_REAL, MPI_SUM, comm1dx,  &
2224                                             ierr )
2225#else
2226                         local_2d_sections = local_2d_sections_l
2227#endif
2228                      ENDIF
2229!
2230!--                   Do not output redundant ghost point data except for the
2231!--                   boundaries of the total domain.
[2512]2232!                      IF ( nyn == ny )  THEN
2233!                         nc_stat = NF90_PUT_VAR( id_set_yz(av),                &
[3554]2234!                                             id_var_do2d(av,ivar),               &
[2512]2235!                                             local_2d_sections(1:ns,           &
2236!                                                nys:nyn+1,nzb_do:nzt_do),      &
2237!                                             start = (/ 1, nys+1, 1,           &
2238!                                                do2d_yz_time_count(av) /),     &
2239!                                             count = (/ ns, nyn-nys+2,         &
2240!                                                        nzt_do-nzb_do+1, 1 /) )
2241!                      ELSE
[1308]2242                         nc_stat = NF90_PUT_VAR( id_set_yz(av),                &
[3554]2243                                             id_var_do2d(av,ivar),               &
[1308]2244                                             local_2d_sections(1:ns,nys:nyn,   &
[1551]2245                                                nzb_do:nzt_do),                &
[1308]2246                                             start = (/ 1, nys+1, 1,           &
2247                                                do2d_yz_time_count(av) /),     &
2248                                             count = (/ ns, nyn-nys+1,         &
[1551]2249                                                        nzt_do-nzb_do+1, 1 /) )
[2512]2250!                      ENDIF
[1308]2251
[1783]2252                      CALL netcdf_handle_error( 'data_output_2d', 60 )
[1308]2253
2254                   CASE DEFAULT
2255                      message_string = 'unknown cross-section: ' // TRIM( mode )
2256                      CALL message( 'data_output_2d', 'PA0180', 1, 2, 0, 6, 0 )
2257
2258                END SELECT                     
2259
2260          ENDIF
[1311]2261#endif
[1]2262       ENDIF
2263
[3554]2264       ivar = ivar + 1
2265       l = MAX( 2, LEN_TRIM( do2d(av,ivar) ) )
2266       do2d_mode = do2d(av,ivar)(l-1:l)
[1]2267
2268    ENDDO
2269
2270!
2271!-- Deallocate temporary arrays.
2272    IF ( ALLOCATED( level_z ) )  DEALLOCATE( level_z )
[1308]2273    IF ( netcdf_data_format > 4 )  THEN
2274       DEALLOCATE( local_pf, local_2d, local_2d_sections )
2275       IF( mode == 'xz' .OR. mode == 'yz' ) DEALLOCATE( local_2d_sections_l )
2276    ENDIF
[1]2277#if defined( __parallel )
2278    IF ( .NOT.  data_output_2d_on_each_pe  .AND.  myid == 0 )  THEN
2279       DEALLOCATE( total_2d )
2280    ENDIF
2281#endif
2282
2283!
2284!-- Close plot output file.
[1960]2285    file_id = 20 + s_ind
[1]2286
2287    IF ( data_output_2d_on_each_pe )  THEN
[759]2288       DO  i = 0, io_blocks-1
2289          IF ( i == io_group )  THEN
2290             CALL close_file( file_id )
2291          ENDIF
2292#if defined( __parallel )
2293          CALL MPI_BARRIER( comm2d, ierr )
2294#endif
2295       ENDDO
[1]2296    ELSE
2297       IF ( myid == 0 )  CALL close_file( file_id )
2298    ENDIF
2299
[1318]2300    CALL cpu_log( log_point(3), 'data_output_2d', 'stop' )
[1]2301
[3987]2302    IF ( debug_output_timestep )  CALL debug_message( 'data_output_2d', 'end' )
[3885]2303
[3987]2304
[1]2305 END SUBROUTINE data_output_2d
Note: See TracBrowser for help on using the repository browser.