source: palm/tags/release-3.2b/SOURCE/data_output_2d.f90 @ 237

Last change on this file since 237 was 77, checked in by raasch, 17 years ago

New:
---

particle reflection from vertical walls implemented, particle SGS model adjusted to walls

Wall functions for vertical walls now include diabatic conditions. New subroutines wall_fluxes, wall_fluxes_e. New 4D-array rif_wall.

new d3par-parameter netcdf_64bit_3d to switch on 64bit offset only for 3D files

new d3par-parameter dt_max to define the maximum value for the allowed timestep

new inipar-parameter loop_optimization to control the loop optimization method

new inipar-parameter pt_refrence. If given, this value is used as the reference that in buoyancy terms (otherwise, the instantaneous horizontally averaged temperature is used).

new user interface user_advec_particles

new initializing action "by_user" calls user_init_3d_model and allows the initial setting of all 3d arrays

topography height informations are stored on arrays zu_s_inner and zw_w_inner and output to the 2d/3d NetCDF files

samples added to the user interface which show how to add user-define time series quantities.

calculation/output of precipitation amount, precipitation rate and z0 (by setting "pra*", "prr*", "z0*" with data_output). The time interval on which the precipitation amount is defined is set by new d3par-parameter precipitation_amount_interval

unit 9 opened for debug output (file DEBUG_<pe#>)

Makefile, advec_particles, average_3d_data, buoyancy, calc_precipitation, check_open, check_parameters, data_output_2d, diffusion_e, diffusion_u, diffusion_v, diffusion_w, diffusivities, header, impact_of_latent_heat, init_particles, init_3d_model, modules, netcdf, parin, production_e, read_var_list, read_3d_binary, sum_up_3d_data, user_interface, write_var_list, write_3d_binary

New: wall_fluxes

Changed:


General revision of non-cyclic horizontal boundary conditions: radiation boundary conditions are now used instead of Neumann conditions at the outflow (calculation needs velocity values for t-dt, which are stored on new arrays u_m_l, u_m_r, etc.), calculation of mean outflow is not needed any more, volume flow control is added for the outflow boundary (currently only for the north boundary!!), additional gridpoints along x and y (uxrp, vynp) are not needed any more, routine "boundary_conds" now operates on timelevel t+dt and is not split in two parts (main, uvw_outflow) any more, Neumann boundary conditions at inflow/outflow in case of non-cyclic boundary conditions for all 2d-arrays that are handled by exchange_horiz_2d

The FFT-method for solving the Poisson-equation is now working with Neumann boundary conditions both at the bottom and the top. This requires adjustments of the tridiagonal coefficients and subtracting the horizontally averaged mean from the vertical velocity field.

+age_m in particle_type

Particles-package is now part of the default code ("-p particles" is not needed any more).

Move call of user_actions( 'after_integration' ) below increment of times
and counters. user_actions is now called for each statistic region and has as an argument the number of the respective region (sr)

d3par-parameter data_output_ts removed. Timeseries output for "profil" removed. Timeseries are now switched on by dt_dots. Timeseries data is collected in flow_statistics.

Initial velocities at nzb+1 are regarded for volume flow control in case they have been set zero before (to avoid small timesteps); see new internal parameters u/v_nzb_p1_for_vfc.

q is not allowed to become negative (prognostic_equations).

poisfft_init is only called if fft-solver is switched on (init_pegrid).

d3par-parameter moisture renamed to humidity.

Subversion global revision number is read from mrun and added to the run description header and to the run control (_rc) file.

vtk directives removed from main program.

The uitility routine interpret_config reads PALM environment variables from NAMELIST instead using the system call GETENV.

advec_u_pw, advec_u_up, advec_v_pw, advec_v_up, asselin_filter, check_parameters, coriolis, data_output_dvrp, data_output_ptseries, data_output_ts, data_output_2d, data_output_3d, diffusion_u, diffusion_v, exchange_horiz, exchange_horiz_2d, flow_statistics, header, init_grid, init_particles, init_pegrid, init_rankine, init_pt_anomaly, init_1d_model, init_3d_model, modules, palm, package_parin, parin, poisfft, poismg, prandtl_fluxes, pres, production_e, prognostic_equations, read_var_list, read_3d_binary, sor, swap_timelevel, time_integration, write_var_list, write_3d_binary

Errors:


Bugfix: preset of tendencies te_em, te_um, te_vm in init_1d_model

Bugfix in sample for reading user defined data from restart file (user_init)

Bugfix in setting diffusivities for cases with the outflow damping layer extending over more than one subdomain (init_3d_model)

Check for possible negative humidities in the initial humidity profile.

in Makefile, default suffixes removed from the suffix list to avoid calling of m2c in
# case of .mod files

Makefile
check_parameters, init_1d_model, init_3d_model, user_interface

  • Property svn:keywords set to Id
File size: 46.4 KB
Line 
1 SUBROUTINE data_output_2d( mode, av )
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: data_output_2d.f90 77 2007-03-29 04:26:56Z raasch $
11!
12! 75 2007-03-22 09:54:05Z raasch
13! Output of precipitation amount/rate and roughness length,
14! 2nd+3rd argument removed from exchange horiz
15!
16! RCS Log replace by Id keyword, revision history cleaned up
17!
18! Revision 1.5  2006/08/22 13:50:29  raasch
19! xz and yz cross sections now up to nzt+1
20!
21! Revision 1.2  2006/02/23 10:19:22  raasch
22! Output of time-averaged data, output of averages along x, y, or z,
23! output of user-defined quantities,
24! section data are copied from local_pf to local_2d before they are output,
25! output of particle concentration and mean radius,
26! Former subroutine plot_2d renamed data_output_2d, pl2d.. renamed do2d..,
27! anz renamed ngp, ebene renamed section, pl2d_.._anz renamed do2d_.._n
28!
29! Revision 1.1  1997/08/11 06:24:09  raasch
30! Initial revision
31!
32!
33! Description:
34! ------------
35! Data output of horizontal cross-sections in NetCDF format or binary format
36! compatible to old graphic software iso2d.
37! Attention: The position of the sectional planes is still not always computed
38! ---------  correctly. (zu is used always)!
39!------------------------------------------------------------------------------!
40
41    USE arrays_3d
42    USE averaging
43    USE cloud_parameters
44    USE control_parameters
45    USE cpulog
46    USE grid_variables
47    USE indices
48    USE interfaces
49    USE netcdf_control
50    USE particle_attributes
51    USE pegrid
52
53    IMPLICIT NONE
54
55    CHARACTER (LEN=2)  ::  do2d_mode, mode
56    CHARACTER (LEN=4)  ::  grid
57    CHARACTER (LEN=25) ::  section_chr
58    CHARACTER (LEN=50) ::  rtext
59    INTEGER ::  av, ngp, file_id, i, if, is, j, k, l, layer_xy, n, psi, s, &
60                sender, &
61                ind(4)
62    LOGICAL ::  found, resorted, two_d
63    REAL    ::  mean_r, s_r3, s_r4
64    REAL, DIMENSION(:), ALLOCATABLE ::      level_z
65    REAL, DIMENSION(:,:), ALLOCATABLE ::    local_2d, local_2d_l
66    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  local_pf
67#if defined( __parallel )
68    REAL, DIMENSION(:,:),   ALLOCATABLE ::  total_2d
69#endif
70    REAL, DIMENSION(:,:,:), POINTER ::  to_be_resorted
71
72    NAMELIST /LOCAL/  rtext
73
74    CALL cpu_log (log_point(3),'data_output_2d','start')
75
76!
77!-- Immediate return, if no output is requested (no respective sections
78!-- found in parameter data_output)
79    IF ( mode == 'xy'  .AND.  .NOT. data_output_xy(av) )  RETURN
80    IF ( mode == 'xz'  .AND.  .NOT. data_output_xz(av) )  RETURN
81    IF ( mode == 'yz'  .AND.  .NOT. data_output_yz(av) )  RETURN
82
83    two_d = .FALSE.    ! local variable to distinguish between output of pure 2D
84                       ! arrays and cross-sections of 3D arrays.
85
86!
87!-- Depending on the orientation of the cross-section, the respective output
88!-- files have to be opened.
89    SELECT CASE ( mode )
90
91       CASE ( 'xy' )
92
93          s = 1
94          ALLOCATE( level_z(0:nzt+1), local_2d(nxl-1:nxr+1,nys-1:nyn+1) )
95
96#if defined( __netcdf )
97          IF ( myid == 0  .AND.  netcdf_output )  CALL check_open( 101+av*10 )
98#endif
99
100          IF ( data_output_2d_on_each_pe )  THEN
101             CALL check_open( 21 )
102          ELSE
103             IF ( myid == 0 )  THEN
104                IF ( iso2d_output )  CALL check_open( 21 )
105#if defined( __parallel )
106                ALLOCATE( total_2d(-1:nx+1,-1:ny+1) )
107#endif
108             ENDIF
109          ENDIF
110
111       CASE ( 'xz' )
112
113          s = 2
114          ALLOCATE( local_2d(nxl-1:nxr+1,nzb:nzt+1) )
115
116#if defined( __netcdf )
117          IF ( myid == 0  .AND.  netcdf_output )  CALL check_open( 102+av*10 )
118#endif
119
120          IF ( data_output_2d_on_each_pe )  THEN
121             CALL check_open( 22 )
122          ELSE
123             IF ( myid == 0 )  THEN
124                IF ( iso2d_output )  CALL check_open( 22 )
125#if defined( __parallel )
126                ALLOCATE( total_2d(-1:nx+1,nzb:nzt+1) )
127#endif
128             ENDIF
129          ENDIF
130
131       CASE ( 'yz' )
132
133          s = 3
134          ALLOCATE( local_2d(nys-1:nyn+1,nzb:nzt+1) )
135
136#if defined( __netcdf )
137          IF ( myid == 0  .AND.  netcdf_output )  CALL check_open( 103+av*10 )
138#endif
139
140          IF ( data_output_2d_on_each_pe )  THEN
141             CALL check_open( 23 )
142          ELSE
143             IF ( myid == 0 )  THEN
144                IF ( iso2d_output )  CALL check_open( 23 )
145#if defined( __parallel )
146                ALLOCATE( total_2d(-1:ny+1,nzb:nzt+1) )
147#endif
148             ENDIF
149          ENDIF
150
151       CASE DEFAULT
152
153          PRINT*,'+++ data_output_2d: unknown cross-section: ',mode
154          CALL local_stop
155
156    END SELECT
157
158!
159!-- Allocate a temporary array for resorting (kji -> ijk).
160    ALLOCATE( local_pf(nxl-1:nxr+1,nys-1:nyn+1,nzb:nzt+1) )
161
162!
163!-- Loop of all variables to be written.
164!-- Output dimensions chosen
165    if = 1
166    l = MAX( 2, LEN_TRIM( do2d(av,if) ) )
167    do2d_mode = do2d(av,if)(l-1:l)
168
169    DO  WHILE ( do2d(av,if)(1:1) /= ' ' )
170
171       IF ( do2d_mode == mode )  THEN
172!
173!--       Store the array chosen on the temporary array.
174          resorted = .FALSE.
175          SELECT CASE ( TRIM( do2d(av,if) ) )
176
177             CASE ( 'e_xy', 'e_xz', 'e_yz' )
178                IF ( av == 0 )  THEN
179                   to_be_resorted => e
180                ELSE
181                   to_be_resorted => e_av
182                ENDIF
183                IF ( mode == 'xy' )  level_z = zu
184
185             CASE ( 'lwp*_xy' )        ! 2d-array
186                IF ( av == 0 )  THEN
187                   DO  i = nxl-1, nxr+1
188                      DO  j = nys-1, nyn+1
189                         local_pf(i,j,nzb+1) = SUM( ql(nzb:nzt,j,i) * &
190                                                    dzw(1:nzt+1) )
191                      ENDDO
192                   ENDDO
193                ELSE
194                   DO  i = nxl-1, nxr+1
195                      DO  j = nys-1, nyn+1
196                         local_pf(i,j,nzb+1) = lwp_av(j,i)
197                      ENDDO
198                   ENDDO
199                ENDIF
200                resorted = .TRUE.
201                two_d = .TRUE.
202                level_z(nzb+1) = zu(nzb+1)
203
204             CASE ( 'p_xy', 'p_xz', 'p_yz' )
205                IF ( av == 0 )  THEN
206                   to_be_resorted => p
207                ELSE
208                   to_be_resorted => p_av
209                ENDIF
210                IF ( mode == 'xy' )  level_z = zu
211
212             CASE ( 'pc_xy', 'pc_xz', 'pc_yz' )  ! particle concentration
213                IF ( av == 0 )  THEN
214                   tend = prt_count
215                   CALL exchange_horiz( tend )
216                   DO  i = nxl-1, nxr+1
217                      DO  j = nys-1, nyn+1
218                         DO  k = nzb, nzt+1
219                            local_pf(i,j,k) = tend(k,j,i)
220                         ENDDO
221                      ENDDO
222                   ENDDO
223                   resorted = .TRUE.
224                ELSE
225                   CALL exchange_horiz( pc_av )
226                   to_be_resorted => pc_av
227                ENDIF
228
229             CASE ( 'pr_xy', 'pr_xz', 'pr_yz' )  ! mean particle radius
230                IF ( av == 0 )  THEN
231                   DO  i = nxl, nxr
232                      DO  j = nys, nyn
233                         DO  k = nzb, nzt+1
234                            psi = prt_start_index(k,j,i)
235                            s_r3 = 0.0
236                            s_r4 = 0.0
237                            DO  n = psi, psi+prt_count(k,j,i)-1
238                               s_r3 = s_r3 + particles(n)%radius**3
239                               s_r4 = s_r4 + particles(n)%radius**4
240                            ENDDO
241                            IF ( s_r3 /= 0.0 )  THEN
242                               mean_r = s_r4 / s_r3
243                            ELSE
244                               mean_r = 0.0
245                            ENDIF
246                            tend(k,j,i) = mean_r
247                         ENDDO
248                      ENDDO
249                   ENDDO
250                   CALL exchange_horiz( tend )
251                   DO  i = nxl-1, nxr+1
252                      DO  j = nys-1, nyn+1
253                         DO  k = nzb, nzt+1
254                            local_pf(i,j,k) = tend(k,j,i)
255                         ENDDO
256                      ENDDO
257                   ENDDO
258                   resorted = .TRUE.
259                ELSE
260                   CALL exchange_horiz( pr_av )
261                   to_be_resorted => pr_av
262                ENDIF
263
264             CASE ( 'pra*_xy' )        ! 2d-array / integral quantity => no av
265                CALL exchange_horiz_2d( precipitation_amount )
266                DO  i = nxl-1, nxr+1
267                   DO  j = nys-1, nyn+1
268                      local_pf(i,j,nzb+1) =  precipitation_amount(j,i)
269                   ENDDO
270                ENDDO
271                precipitation_amount = 0.0   ! reset for next integ. interval
272                resorted = .TRUE.
273                two_d = .TRUE.
274                level_z(nzb+1) = zu(nzb+1)
275
276             CASE ( 'prr*_xy' )        ! 2d-array
277                IF ( av == 0 )  THEN
278                   CALL exchange_horiz_2d( precipitation_rate )
279                   DO  i = nxl-1, nxr+1
280                      DO  j = nys-1, nyn+1 
281                         local_pf(i,j,nzb+1) =  precipitation_rate(j,i)
282                      ENDDO
283                   ENDDO
284                ELSE
285                   CALL exchange_horiz_2d( precipitation_rate_av )
286                   DO  i = nxl-1, nxr+1
287                      DO  j = nys-1, nyn+1 
288                         local_pf(i,j,nzb+1) =  precipitation_rate_av(j,i)
289                      ENDDO
290                   ENDDO
291                ENDIF
292                resorted = .TRUE.
293                two_d = .TRUE.
294                level_z(nzb+1) = zu(nzb+1)
295
296             CASE ( 'pt_xy', 'pt_xz', 'pt_yz' )
297                IF ( av == 0 )  THEN
298                   IF ( .NOT. cloud_physics ) THEN
299                      to_be_resorted => pt
300                   ELSE
301                      DO  i = nxl-1, nxr+1
302                         DO  j = nys-1, nyn+1
303                            DO  k = nzb, nzt+1
304                               local_pf(i,j,k) = pt(k,j,i) + l_d_cp *    &
305                                                             pt_d_t(k) * &
306                                                             ql(k,j,i)
307                            ENDDO
308                         ENDDO
309                      ENDDO
310                      resorted = .TRUE.
311                   ENDIF
312                ELSE
313                   to_be_resorted => pt_av
314                ENDIF
315                IF ( mode == 'xy' )  level_z = zu
316
317             CASE ( 'q_xy', 'q_xz', 'q_yz' )
318                IF ( av == 0 )  THEN
319                   to_be_resorted => q
320                ELSE
321                   to_be_resorted => q_av
322                ENDIF
323                IF ( mode == 'xy' )  level_z = zu
324
325             CASE ( 'ql_xy', 'ql_xz', 'ql_yz' )
326                IF ( av == 0 )  THEN
327                   to_be_resorted => ql
328                ELSE
329                   to_be_resorted => ql_av
330                ENDIF
331                IF ( mode == 'xy' )  level_z = zu
332
333             CASE ( 'ql_c_xy', 'ql_c_xz', 'ql_c_yz' )
334                IF ( av == 0 )  THEN
335                   to_be_resorted => ql_c
336                ELSE
337                   to_be_resorted => ql_c_av
338                ENDIF
339                IF ( mode == 'xy' )  level_z = zu
340
341             CASE ( 'ql_v_xy', 'ql_v_xz', 'ql_v_yz' )
342                IF ( av == 0 )  THEN
343                   to_be_resorted => ql_v
344                ELSE
345                   to_be_resorted => ql_v_av
346                ENDIF
347                IF ( mode == 'xy' )  level_z = zu
348
349             CASE ( 'ql_vp_xy', 'ql_vp_xz', 'ql_vp_yz' )
350                IF ( av == 0 )  THEN
351                   to_be_resorted => ql_vp
352                ELSE
353                   to_be_resorted => ql_vp_av
354                ENDIF
355                IF ( mode == 'xy' )  level_z = zu
356
357             CASE ( 'qv_xy', 'qv_xz', 'qv_yz' )
358                IF ( av == 0 )  THEN
359                   DO  i = nxl-1, nxr+1
360                      DO  j = nys-1, nyn+1
361                         DO  k = nzb, nzt+1
362                            local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
363                         ENDDO
364                      ENDDO
365                   ENDDO
366                   resorted = .TRUE.
367                ELSE
368                   to_be_resorted => qv_av
369                ENDIF
370                IF ( mode == 'xy' )  level_z = zu
371
372             CASE ( 's_xy', 's_xz', 's_yz' )
373                IF ( av == 0 )  THEN
374                   to_be_resorted => q
375                ELSE
376                   to_be_resorted => q_av
377                ENDIF
378
379             CASE ( 't*_xy' )        ! 2d-array
380                IF ( av == 0 )  THEN
381                   DO  i = nxl-1, nxr+1
382                      DO  j = nys-1, nyn+1
383                         local_pf(i,j,nzb+1) = ts(j,i)
384                      ENDDO
385                   ENDDO
386                ELSE
387                   DO  i = nxl-1, nxr+1
388                      DO  j = nys-1, nyn+1
389                         local_pf(i,j,nzb+1) = ts_av(j,i)
390                      ENDDO
391                   ENDDO
392                ENDIF
393                resorted = .TRUE.
394                two_d = .TRUE.
395                level_z(nzb+1) = zu(nzb+1)
396
397             CASE ( 'u_xy', 'u_xz', 'u_yz' )
398                IF ( av == 0 )  THEN
399                   to_be_resorted => u
400                ELSE
401                   to_be_resorted => u_av
402                ENDIF
403                IF ( mode == 'xy' )  level_z = zu
404!
405!--             Substitute the values generated by "mirror" boundary condition
406!--             at the bottom boundary by the real surface values.
407                IF ( do2d(av,if) == 'u_xz'  .OR.  do2d(av,if) == 'u_yz' )  THEN
408                   IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0
409                ENDIF
410
411             CASE ( 'u*_xy' )        ! 2d-array
412                IF ( av == 0 )  THEN
413                   DO  i = nxl-1, nxr+1
414                      DO  j = nys-1, nyn+1
415                         local_pf(i,j,nzb+1) = us(j,i)
416                      ENDDO
417                   ENDDO
418                ELSE
419                   DO  i = nxl-1, nxr+1
420                      DO  j = nys-1, nyn+1
421                         local_pf(i,j,nzb+1) = us_av(j,i)
422                      ENDDO
423                   ENDDO
424                ENDIF
425                resorted = .TRUE.
426                two_d = .TRUE.
427                level_z(nzb+1) = zu(nzb+1)
428
429             CASE ( 'v_xy', 'v_xz', 'v_yz' )
430                IF ( av == 0 )  THEN
431                   to_be_resorted => v
432                ELSE
433                   to_be_resorted => v_av
434                ENDIF
435                IF ( mode == 'xy' )  level_z = zu
436!
437!--             Substitute the values generated by "mirror" boundary condition
438!--             at the bottom boundary by the real surface values.
439                IF ( do2d(av,if) == 'v_xz'  .OR.  do2d(av,if) == 'v_yz' )  THEN
440                   IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0
441                ENDIF
442
443             CASE ( 'vpt_xy', 'vpt_xz', 'vpt_yz' )
444                IF ( av == 0 )  THEN
445                   to_be_resorted => vpt
446                ELSE
447                   to_be_resorted => vpt_av
448                ENDIF
449                IF ( mode == 'xy' )  level_z = zu
450
451             CASE ( 'w_xy', 'w_xz', 'w_yz' )
452                IF ( av == 0 )  THEN
453                   to_be_resorted => w
454                ELSE
455                   to_be_resorted => w_av
456                ENDIF
457                IF ( mode == 'xy' )  level_z = zw
458
459             CASE ( 'z0*_xy' )        ! 2d-array
460                IF ( av == 0 ) THEN
461                   DO  i = nxl-1, nxr+1
462                      DO  j = nys-1, nyn+1 
463                         local_pf(i,j,nzb+1) =  z0(j,i)
464                      ENDDO
465                   ENDDO
466                ELSE
467                   DO  i = nxl-1, nxr+1
468                      DO  j = nys-1, nyn+1 
469                         local_pf(i,j,nzb+1) =  z0_av(j,i)
470                      ENDDO
471                   ENDDO
472                ENDIF
473                resorted = .TRUE.
474                two_d = .TRUE.
475                level_z(nzb+1) = zu(nzb+1)
476
477             CASE DEFAULT
478!
479!--             User defined quantity
480                CALL user_data_output_2d( av, do2d(av,if), found, grid, &
481                                          local_pf )
482                resorted = .TRUE.
483
484                IF ( grid == 'zu' )  THEN
485                   IF ( mode == 'xy' )  level_z = zu
486                ELSEIF ( grid == 'zw' )  THEN
487                   IF ( mode == 'xy' )  level_z = zw
488                ENDIF
489
490                IF ( .NOT. found )  THEN
491                   PRINT*, '+++ data_output_2d: no output provided for: ', &
492                                do2d(av,if)
493                ENDIF
494
495          END SELECT
496
497!
498!--       Resort the array to be output, if not done above
499          IF ( .NOT. resorted )  THEN
500             DO  i = nxl-1, nxr+1
501                DO  j = nys-1, nyn+1
502                   DO  k = nzb, nzt+1
503                      local_pf(i,j,k) = to_be_resorted(k,j,i)
504                   ENDDO
505                ENDDO
506             ENDDO
507          ENDIF
508
509!
510!--       Output of the individual cross-sections, depending on the cross-
511!--       section mode chosen.
512          is = 1
513   loop1: DO  WHILE ( section(is,s) /= -9999  .OR.  two_d )
514
515             SELECT CASE ( mode )
516
517                CASE ( 'xy' )
518!
519!--                Determine the cross section index
520                   IF ( two_d )  THEN
521                      layer_xy = nzb+1
522                   ELSE
523                      layer_xy = section(is,s)
524                   ENDIF
525
526!
527!--                Update the NetCDF xy cross section time axis
528                   IF ( myid == 0 )  THEN
529                      IF ( simulated_time /= do2d_xy_last_time(av) )  THEN
530                         do2d_xy_time_count(av) = do2d_xy_time_count(av) + 1
531                         do2d_xy_last_time(av)  = simulated_time
532                         IF ( .NOT. data_output_2d_on_each_pe  .AND. &
533                              netcdf_output )  THEN
534#if defined( __netcdf )
535                            nc_stat = NF90_PUT_VAR( id_set_xy(av),             &
536                                                    id_var_time_xy(av),        &
537                                                    (/ simulated_time /),      &
538                                         start = (/ do2d_xy_time_count(av) /), &
539                                                    count = (/ 1 /) )
540                            IF ( nc_stat /= NF90_NOERR )  THEN
541                               CALL handle_netcdf_error( 53 )
542                            ENDIF
543#endif
544                         ENDIF
545                      ENDIF
546                   ENDIF
547!
548!--                If required, carry out averaging along z
549                   IF ( section(is,s) == -1 )  THEN
550
551                      local_2d = 0.0
552!
553!--                   Carry out the averaging (all data are on the PE)
554                      DO  k = nzb, nzt+1
555                         DO  j = nys-1, nyn+1
556                            DO  i = nxl-1, nxr+1
557                               local_2d(i,j) = local_2d(i,j) + local_pf(i,j,k)
558                            ENDDO
559                         ENDDO
560                      ENDDO
561
562                      local_2d = local_2d / ( nzt -nzb + 2.0 )
563
564                   ELSE
565!
566!--                   Just store the respective section on the local array
567                      local_2d = local_pf(:,:,layer_xy)
568
569                   ENDIF
570
571#if defined( __parallel )
572                   IF ( data_output_2d_on_each_pe )  THEN
573!
574!--                   Output of partial arrays on each PE
575#if defined( __netcdf )
576                      IF ( netcdf_output  .AND.  myid == 0 )  THEN
577                         WRITE ( 21 )  simulated_time, do2d_xy_time_count(av), &
578                                       av
579                      ENDIF
580#endif
581                      WRITE ( 21 )  nxl-1, nxr+1, nys-1, nyn+1
582                      WRITE ( 21 )  local_2d
583
584                   ELSE
585!
586!--                   PE0 receives partial arrays from all processors and then
587!--                   outputs them. Here a barrier has to be set, because
588!--                   otherwise "-MPI- FATAL: Remote protocol queue full" may
589!--                   occur.
590                      CALL MPI_BARRIER( comm2d, ierr )
591
592                      ngp = ( nxr-nxl+3 ) * ( nyn-nys+3 )
593                      IF ( myid == 0 )  THEN
594!
595!--                      Local array can be relocated directly.
596                         total_2d(nxl-1:nxr+1,nys-1:nyn+1) = local_2d
597!
598!--                      Receive data from all other PEs.
599                         DO  n = 1, numprocs-1
600!
601!--                         Receive index limits first, then array.
602!--                         Index limits are received in arbitrary order from
603!--                         the PEs.
604                            CALL MPI_RECV( ind(1), 4, MPI_INTEGER,            &
605                                           MPI_ANY_SOURCE, 0, comm2d, status, &
606                                           ierr )
607                            sender = status(MPI_SOURCE)
608                            DEALLOCATE( local_2d )
609                            ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
610                            CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp,      &
611                                           MPI_REAL, sender, 1, comm2d,       &
612                                           status, ierr )
613                            total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
614                         ENDDO
615!
616!--                      Output of the total cross-section.
617                         IF ( iso2d_output ) WRITE (21)  total_2d(0:nx+1,0:ny+1)
618!
619!--                      Relocate the local array for the next loop increment
620                         DEALLOCATE( local_2d )
621                         ALLOCATE( local_2d(nxl-1:nxr+1,nys-1:nyn+1) )
622
623#if defined( __netcdf )
624                         IF ( netcdf_output )  THEN
625                            IF ( two_d ) THEN
626                               nc_stat = NF90_PUT_VAR( id_set_xy(av),          &
627                                                       id_var_do2d(av,if),     &
628                                                      total_2d(0:nx+1,0:ny+1), &
629                                start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
630                                                count = (/ nx+2, ny+2, 1, 1 /) )
631                            ELSE
632                               nc_stat = NF90_PUT_VAR( id_set_xy(av),          &
633                                                       id_var_do2d(av,if),     &
634                                                      total_2d(0:nx+1,0:ny+1), &
635                               start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
636                                                count = (/ nx+2, ny+2, 1, 1 /) )
637                            ENDIF
638                            IF ( nc_stat /= NF90_NOERR )  &
639                                                  CALL handle_netcdf_error( 54 )
640                         ENDIF
641#endif
642
643                      ELSE
644!
645!--                      First send the local index limits to PE0
646                         ind(1) = nxl-1; ind(2) = nxr+1
647                         ind(3) = nys-1; ind(4) = nyn+1
648                         CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, &
649                                        ierr )
650!
651!--                      Send data to PE0
652                         CALL MPI_SEND( local_2d(nxl-1,nys-1), ngp, MPI_REAL, &
653                                        0, 1, comm2d, ierr )
654                      ENDIF
655!
656!--                   A barrier has to be set, because otherwise some PEs may
657!--                   proceed too fast so that PE0 may receive wrong data on
658!--                   tag 0
659                      CALL MPI_BARRIER( comm2d, ierr )
660                   ENDIF
661#else
662                   IF ( iso2d_output )  THEN
663                      WRITE (21)  local_2d(nxl:nxr+1,nys:nyn+1)
664                   ENDIF
665#if defined( __netcdf )
666                   IF ( netcdf_output )  THEN
667                      IF ( two_d ) THEN
668                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
669                                                 id_var_do2d(av,if),           &
670                                                local_2d(nxl:nxr+1,nys:nyn+1), &
671                                start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
672                                              count = (/ nx+2, ny+2, 1, 1 /) )
673                      ELSE
674                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
675                                                 id_var_do2d(av,if),           &
676                                                local_2d(nxl:nxr+1,nys:nyn+1), &
677                               start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
678                                              count = (/ nx+2, ny+2, 1, 1 /) )
679                      ENDIF
680                      IF ( nc_stat /= NF90_NOERR )  &
681                                                  CALL handle_netcdf_error( 55 )
682                   ENDIF
683#endif
684#endif
685                   do2d_xy_n = do2d_xy_n + 1
686!
687!--                Write LOCAL parameter set for ISO2D.
688                   IF ( myid == 0  .AND.  iso2d_output )  THEN
689                      IF ( section(is,s) /= -1 )  THEN
690                         WRITE ( section_chr, '(''z = '',F7.2,'' m  (GP '',I3, &
691                                               &'')'')'                        &
692                               )  level_z(layer_xy), layer_xy
693                      ELSE
694                         section_chr = 'averaged along z'
695                      ENDIF
696                      IF ( av == 0 )  THEN
697                         rtext = TRIM( do2d(av,if) ) // '  t = ' //    &
698                                 TRIM( simulated_time_chr ) // '  ' // &
699                                 TRIM( section_chr )
700                      ELSE
701                         rtext = TRIM( do2d(av,if) ) // '  averaged t = ' // &
702                                 TRIM( simulated_time_chr ) // '  ' //       &
703                                 TRIM( section_chr )
704                      ENDIF
705                      WRITE (27,LOCAL)
706                   ENDIF
707!
708!--                For 2D-arrays (e.g. u*) only one cross-section is available.
709!--                Hence exit loop of output levels.
710                   IF ( two_d )  THEN
711                      two_d = .FALSE.
712                      EXIT loop1
713                   ENDIF
714
715                CASE ( 'xz' )
716!
717!--                Update the NetCDF xy cross section time axis
718                   IF ( myid == 0 )  THEN
719                      IF ( simulated_time /= do2d_xz_last_time(av) )  THEN
720                         do2d_xz_time_count(av) = do2d_xz_time_count(av) + 1
721                         do2d_xz_last_time(av)  = simulated_time
722                         IF ( .NOT. data_output_2d_on_each_pe  .AND. &
723                              netcdf_output )  THEN
724#if defined( __netcdf )
725                            nc_stat = NF90_PUT_VAR( id_set_xz(av),             &
726                                                    id_var_time_xz(av),        &
727                                                    (/ simulated_time /),      &
728                                         start = (/ do2d_xz_time_count(av) /), &
729                                                    count = (/ 1 /) )
730                            IF ( nc_stat /= NF90_NOERR )  THEN
731                               CALL handle_netcdf_error( 56 )
732                            ENDIF
733#endif
734                         ENDIF
735                      ENDIF
736                   ENDIF
737!
738!--                If required, carry out averaging along y
739                   IF ( section(is,s) == -1 )  THEN
740
741                      ALLOCATE( local_2d_l(nxl-1:nxr+1,nzb:nzt+1) )
742                      local_2d_l = 0.0
743                      ngp = ( nxr-nxl+3 ) * ( nzt-nzb+2 )
744!
745!--                   First local averaging on the PE
746                      DO  k = nzb, nzt+1
747                         DO  j = nys, nyn
748                            DO  i = nxl-1, nxr+1
749                               local_2d_l(i,k) = local_2d_l(i,k) + &
750                                                 local_pf(i,j,k)
751                            ENDDO
752                         ENDDO
753                      ENDDO
754#if defined( __parallel )
755!
756!--                   Now do the averaging over all PEs along y
757                      CALL MPI_ALLREDUCE( local_2d_l(nxl-1,nzb),              &
758                                          local_2d(nxl-1,nzb), ngp, MPI_REAL, &
759                                          MPI_SUM, comm1dy, ierr )
760#else
761                      local_2d = local_2d_l
762#endif
763                      local_2d = local_2d / ( ny + 1.0 )
764
765                      DEALLOCATE( local_2d_l )
766
767                   ELSE
768!
769!--                   Just store the respective section on the local array
770!--                   (but only if it is available on this PE!)
771                      IF ( section(is,s) >= nys  .AND.  section(is,s) <= nyn ) &
772                      THEN
773                         local_2d = local_pf(:,section(is,s),nzb:nzt+1)
774                      ENDIF
775
776                   ENDIF
777
778#if defined( __parallel )
779                   IF ( data_output_2d_on_each_pe )  THEN
780!
781!--                   Output of partial arrays on each PE. If the cross section
782!--                   does not reside on the PE, output special index values.
783#if defined( __netcdf )
784                      IF ( netcdf_output  .AND.  myid == 0 )  THEN
785                         WRITE ( 22 )  simulated_time, do2d_xz_time_count(av), &
786                                       av
787                      ENDIF
788#endif
789                      IF ( ( section(is,s)>=nys .AND. section(is,s)<=nyn ) .OR.&
790                           ( section(is,s) == -1  .AND.  nys-1 == -1 ) )       &
791                      THEN
792                         WRITE (22)  nxl-1, nxr+1, nzb, nzt+1
793                         WRITE (22)  local_2d
794                      ELSE
795                         WRITE (22)  -1, -1, -1, -1
796                      ENDIF
797
798                   ELSE
799!
800!--                   PE0 receives partial arrays from all processors of the
801!--                   respective cross section and outputs them. Here a
802!--                   barrier has to be set, because otherwise
803!--                   "-MPI- FATAL: Remote protocol queue full" may occur.
804                      CALL MPI_BARRIER( comm2d, ierr )
805
806                      ngp = ( nxr-nxl+3 ) * ( nzt-nzb+2 )
807                      IF ( myid == 0 )  THEN
808!
809!--                      Local array can be relocated directly.
810                         IF ( ( section(is,s)>=nys .AND. section(is,s)<=nyn )  &
811                            .OR. ( section(is,s) == -1  .AND.  nys-1 == -1 ) ) &
812                         THEN
813                            total_2d(nxl-1:nxr+1,nzb:nzt+1) = local_2d
814                         ENDIF
815!
816!--                      Receive data from all other PEs.
817                         DO  n = 1, numprocs-1
818!
819!--                         Receive index limits first, then array.
820!--                         Index limits are received in arbitrary order from
821!--                         the PEs.
822                            CALL MPI_RECV( ind(1), 4, MPI_INTEGER,            &
823                                           MPI_ANY_SOURCE, 0, comm2d, status, &
824                                           ierr )
825!
826!--                         Not all PEs have data for XZ-cross-section.
827                            IF ( ind(1) /= -9999 )  THEN
828                               sender = status(MPI_SOURCE)
829                               DEALLOCATE( local_2d )
830                               ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
831                               CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
832                                              MPI_REAL, sender, 1, comm2d,  &
833                                              status, ierr )
834                               total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
835                            ENDIF
836                         ENDDO
837!
838!--                      Output of the total cross-section.
839                         IF ( iso2d_output )  THEN
840                            WRITE (22)  total_2d(0:nx+1,nzb:nzt+1)
841                         ENDIF
842!
843!--                      Relocate the local array for the next loop increment
844                         DEALLOCATE( local_2d )
845                         ALLOCATE( local_2d(nxl-1:nxr+1,nzb:nzt+1) )
846
847#if defined( __netcdf )
848                         IF ( netcdf_output )  THEN
849                            nc_stat = NF90_PUT_VAR( id_set_xz(av),             &
850                                                    id_var_do2d(av,if),        &
851                                                    total_2d(0:nx+1,nzb:nzt+1),&
852                               start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
853                                                count = (/ nx+2, 1, nz+2, 1 /) )
854                            IF ( nc_stat /= NF90_NOERR ) &
855                                                  CALL handle_netcdf_error( 57 )
856                         ENDIF
857#endif
858
859                      ELSE
860!
861!--                      If the cross section resides on the PE, send the
862!--                      local index limits, otherwise send -9999 to PE0.
863                         IF ( ( section(is,s)>=nys .AND. section(is,s)<=nyn )  &
864                            .OR. ( section(is,s) == -1  .AND.  nys-1 == -1 ) ) &
865                         THEN
866                            ind(1) = nxl-1; ind(2) = nxr+1
867                            ind(3) = nzb;   ind(4) = nzt+1
868                         ELSE
869                            ind(1) = -9999; ind(2) = -9999
870                            ind(3) = -9999; ind(4) = -9999
871                         ENDIF
872                         CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, &
873                                        ierr )
874!
875!--                      If applicable, send data to PE0.
876                         IF ( ind(1) /= -9999 )  THEN
877                            CALL MPI_SEND( local_2d(nxl-1,nzb), ngp, MPI_REAL, &
878                                           0, 1, comm2d, ierr )
879                         ENDIF
880                      ENDIF
881!
882!--                   A barrier has to be set, because otherwise some PEs may
883!--                   proceed too fast so that PE0 may receive wrong data on
884!--                   tag 0
885                      CALL MPI_BARRIER( comm2d, ierr )
886                   ENDIF
887#else
888                   IF ( iso2d_output )  THEN
889                      WRITE (22)  local_2d(nxl:nxr+1,nzb:nzt+1)
890                   ENDIF
891#if defined( __netcdf )
892                   IF ( netcdf_output )  THEN
893                      nc_stat = NF90_PUT_VAR( id_set_xz(av),                   &
894                                              id_var_do2d(av,if),              &
895                                              local_2d(nxl:nxr+1,nzb:nzt+1),   &
896                               start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
897                                              count = (/ nx+2, 1, nz+2, 1 /) )
898                      IF ( nc_stat /= NF90_NOERR )  &
899                                                  CALL handle_netcdf_error( 58 )
900                   ENDIF
901#endif
902#endif
903                   do2d_xz_n = do2d_xz_n + 1
904!
905!--                Write LOCAL-parameter set for ISO2D.
906                   IF ( myid == 0  .AND.  iso2d_output )  THEN
907                      IF ( section(is,s) /= -1 )  THEN
908                         WRITE ( section_chr, '(''y = '',F8.2,'' m  (GP '',I3, &
909                                               &'')'')'                        &
910                               )  section(is,s)*dy, section(is,s)
911                      ELSE
912                         section_chr = 'averaged along y'
913                      ENDIF
914                      IF ( av == 0 )  THEN
915                         rtext = TRIM( do2d(av,if) ) // '  t = ' //    &
916                                 TRIM( simulated_time_chr ) // '  ' // &
917                                 TRIM( section_chr )
918                      ELSE
919                         rtext = TRIM( do2d(av,if) ) // '  averaged t = ' // &
920                                 TRIM( simulated_time_chr ) // '  ' //       &
921                                 TRIM( section_chr )
922                      ENDIF
923                      WRITE (28,LOCAL)
924                   ENDIF
925
926                CASE ( 'yz' )
927!
928!--                Update the NetCDF xy cross section time axis
929                   IF ( myid == 0 )  THEN
930                      IF ( simulated_time /= do2d_yz_last_time(av) )  THEN
931                         do2d_yz_time_count(av) = do2d_yz_time_count(av) + 1
932                         do2d_yz_last_time(av)  = simulated_time
933                         IF ( .NOT. data_output_2d_on_each_pe  .AND. &
934                              netcdf_output )  THEN
935#if defined( __netcdf )
936                            nc_stat = NF90_PUT_VAR( id_set_yz(av),             &
937                                                    id_var_time_yz(av),        &
938                                                    (/ simulated_time /),      &
939                                         start = (/ do2d_yz_time_count(av) /), &
940                                                    count = (/ 1 /) )
941                            IF ( nc_stat /= NF90_NOERR )  THEN
942                               CALL handle_netcdf_error( 59 )
943                            ENDIF
944#endif
945                         ENDIF
946                      ENDIF
947                   ENDIF
948!
949!--                If required, carry out averaging along x
950                   IF ( section(is,s) == -1 )  THEN
951
952                      ALLOCATE( local_2d_l(nys-1:nyn+1,nzb:nzt+1) )
953                      local_2d_l = 0.0
954                      ngp = ( nyn-nys+3 ) * ( nzt-nzb+2 )
955!
956!--                   First local averaging on the PE
957                      DO  k = nzb, nzt+1
958                         DO  j = nys-1, nyn+1
959                            DO  i = nxl, nxr
960                               local_2d_l(j,k) = local_2d_l(j,k) + &
961                                                 local_pf(i,j,k)
962                            ENDDO
963                         ENDDO
964                      ENDDO
965#if defined( __parallel )
966!
967!--                   Now do the averaging over all PEs along x
968                      CALL MPI_ALLREDUCE( local_2d_l(nys-1,nzb),              &
969                                          local_2d(nys-1,nzb), ngp, MPI_REAL, &
970                                          MPI_SUM, comm1dx, ierr )
971#else
972                      local_2d = local_2d_l
973#endif
974                      local_2d = local_2d / ( nx + 1.0 )
975
976                      DEALLOCATE( local_2d_l )
977
978                   ELSE
979!
980!--                   Just store the respective section on the local array
981!--                   (but only if it is available on this PE!)
982                      IF ( section(is,s) >= nxl  .AND.  section(is,s) <= nxr ) &
983                      THEN
984                         local_2d = local_pf(section(is,s),:,nzb:nzt+1)
985                      ENDIF
986
987                   ENDIF
988
989#if defined( __parallel )
990                   IF ( data_output_2d_on_each_pe )  THEN
991!
992!--                   Output of partial arrays on each PE. If the cross section
993!--                   does not reside on the PE, output special index values.
994#if defined( __netcdf )
995                      IF ( netcdf_output  .AND.  myid == 0 )  THEN
996                         WRITE ( 23 )  simulated_time, do2d_yz_time_count(av), &
997                                       av
998                      ENDIF
999#endif
1000                      IF ( ( section(is,s)>=nxl .AND. section(is,s)<=nxr ) .OR.&
1001                           ( section(is,s) ==  -1  .AND.  nxl-1 == -1 ) )      &
1002                      THEN
1003                         WRITE (23)  nys-1, nyn+1, nzb, nzt+1
1004                         WRITE (23)  local_2d
1005                      ELSE
1006                         WRITE (23)  -1, -1, -1, -1
1007                      ENDIF
1008
1009                   ELSE
1010!
1011!--                   PE0 receives partial arrays from all processors of the
1012!--                   respective cross section and outputs them. Here a
1013!--                   barrier has to be set, because otherwise
1014!--                   "-MPI- FATAL: Remote protocol queue full" may occur.
1015                      CALL MPI_BARRIER( comm2d, ierr )
1016
1017                      ngp = ( nyn-nys+3 ) * ( nzt-nzb+2 )
1018                      IF ( myid == 0 )  THEN
1019!
1020!--                      Local array can be relocated directly.
1021                         IF ( ( section(is,s)>=nxl .AND. section(is,s)<=nxr )  &
1022                           .OR. ( section(is,s) ==  -1  .AND.  nxl-1 == -1 ) ) &
1023                         THEN
1024                            total_2d(nys-1:nyn+1,nzb:nzt+1) = local_2d
1025                         ENDIF
1026!
1027!--                      Receive data from all other PEs.
1028                         DO  n = 1, numprocs-1
1029!
1030!--                         Receive index limits first, then array.
1031!--                         Index limits are received in arbitrary order from
1032!--                         the PEs.
1033                            CALL MPI_RECV( ind(1), 4, MPI_INTEGER,            &
1034                                           MPI_ANY_SOURCE, 0, comm2d, status, &
1035                                           ierr )
1036!
1037!--                         Not all PEs have data for YZ-cross-section.
1038                            IF ( ind(1) /= -9999 )  THEN
1039                               sender = status(MPI_SOURCE)
1040                               DEALLOCATE( local_2d )
1041                               ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
1042                               CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
1043                                              MPI_REAL, sender, 1, comm2d,  &
1044                                              status, ierr )
1045                               total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
1046                            ENDIF
1047                         ENDDO
1048!
1049!--                      Output of the total cross-section.
1050                         IF ( iso2d_output )  THEN
1051                            WRITE (23)  total_2d(0:ny+1,nzb:nzt+1)
1052                         ENDIF
1053!
1054!--                      Relocate the local array for the next loop increment
1055                         DEALLOCATE( local_2d )
1056                         ALLOCATE( local_2d(nys-1:nyn+1,nzb:nzt+1) )
1057
1058#if defined( __netcdf )
1059                         IF ( netcdf_output )  THEN
1060                            nc_stat = NF90_PUT_VAR( id_set_yz(av),             &
1061                                                    id_var_do2d(av,if),        &
1062                                                    total_2d(0:ny+1,nzb:nzt+1),&
1063                               start = (/ is, 1, 1, do2d_yz_time_count(av) /), &
1064                                                count = (/ 1, ny+2, nz+2, 1 /) )
1065                            IF ( nc_stat /= NF90_NOERR ) &
1066                                                  CALL handle_netcdf_error( 60 )
1067                         ENDIF
1068#endif
1069
1070                      ELSE
1071!
1072!--                      If the cross section resides on the PE, send the
1073!--                      local index limits, otherwise send -9999 to PE0.
1074                         IF ( ( section(is,s)>=nxl .AND. section(is,s)<=nxr )  &
1075                           .OR. ( section(is,s) ==  -1  .AND.  nxl-1 == -1 ) ) &
1076                         THEN
1077                            ind(1) = nys-1; ind(2) = nyn+1
1078                            ind(3) = nzb;   ind(4) = nzt+1
1079                         ELSE
1080                            ind(1) = -9999; ind(2) = -9999
1081                            ind(3) = -9999; ind(4) = -9999
1082                         ENDIF
1083                         CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, &
1084                                        ierr )
1085!
1086!--                      If applicable, send data to PE0.
1087                         IF ( ind(1) /= -9999 )  THEN
1088                            CALL MPI_SEND( local_2d(nys-1,nzb), ngp, MPI_REAL, &
1089                                           0, 1, comm2d, ierr )
1090                         ENDIF
1091                      ENDIF
1092!
1093!--                   A barrier has to be set, because otherwise some PEs may
1094!--                   proceed too fast so that PE0 may receive wrong data on
1095!--                   tag 0
1096                      CALL MPI_BARRIER( comm2d, ierr )
1097                   ENDIF
1098#else
1099                   IF ( iso2d_output )  THEN
1100                      WRITE (23)  local_2d(nys:nyn+1,nzb:nzt+1)
1101                   ENDIF
1102#if defined( __netcdf )
1103                   IF ( netcdf_output )  THEN
1104                      nc_stat = NF90_PUT_VAR( id_set_yz(av),                   &
1105                                              id_var_do2d(av,if),              &
1106                                              local_2d(nys:nyn+1,nzb:nzt+1),   &
1107                               start = (/ is, 1, 1, do2d_xz_time_count(av) /), &
1108                                              count = (/ 1, ny+2, nz+2, 1 /) )
1109                      IF ( nc_stat /= NF90_NOERR )  &
1110                                                  CALL handle_netcdf_error( 61 )
1111                   ENDIF
1112#endif
1113#endif
1114                   do2d_yz_n = do2d_yz_n + 1
1115!
1116!--                Write LOCAL-parameter set for ISO2D.
1117                   IF ( myid == 0  .AND.  iso2d_output )  THEN
1118                      IF ( section(is,s) /= -1 )  THEN
1119                         WRITE ( section_chr, '(''x = '',F8.2,'' m  (GP '',I3, &
1120                                               &'')'')'                        &
1121                               )  section(is,s)*dx, section(is,s)
1122                      ELSE
1123                         section_chr = 'averaged along x'
1124                      ENDIF
1125                      IF ( av == 0 )  THEN
1126                         rtext = TRIM( do2d(av,if) ) // '  t = ' //    &
1127                                 TRIM( simulated_time_chr ) // '  ' // &
1128                                 TRIM( section_chr )
1129                      ELSE
1130                         rtext = TRIM( do2d(av,if) ) // '  averaged t = ' // &
1131                                 TRIM( simulated_time_chr ) // '  ' //       &
1132                                 TRIM( section_chr )
1133                      ENDIF
1134                      WRITE (29,LOCAL)
1135                   ENDIF
1136
1137             END SELECT
1138
1139             is = is + 1
1140          ENDDO loop1
1141
1142       ENDIF
1143
1144       if = if + 1
1145       l = MAX( 2, LEN_TRIM( do2d(av,if) ) )
1146       do2d_mode = do2d(av,if)(l-1:l)
1147
1148    ENDDO
1149
1150!
1151!-- Deallocate temporary arrays.
1152    IF ( ALLOCATED( level_z ) )  DEALLOCATE( level_z )
1153    DEALLOCATE( local_pf, local_2d )
1154#if defined( __parallel )
1155    IF ( .NOT.  data_output_2d_on_each_pe  .AND.  myid == 0 )  THEN
1156       DEALLOCATE( total_2d )
1157    ENDIF
1158#endif
1159
1160!
1161!-- Close plot output file.
1162    file_id = 20 + s
1163
1164    IF ( data_output_2d_on_each_pe )  THEN
1165       CALL close_file( file_id )
1166    ELSE
1167       IF ( myid == 0 )  CALL close_file( file_id )
1168    ENDIF
1169
1170
1171    CALL cpu_log (log_point(3),'data_output_2d','stop','nobarrier')
1172
1173 END SUBROUTINE data_output_2d
Note: See TracBrowser for help on using the repository browser.