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

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