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

Last change on this file since 978 was 978, checked in by fricke, 12 years ago

merge fricke branch back into trunk

  • Property svn:keywords set to Id
File size: 66.3 KB
Line 
1 SUBROUTINE data_output_2d( mode, av )
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6! +z0h
7!
8! Former revisions:
9! -----------------
10! $Id: data_output_2d.f90 978 2012-08-09 08:28:32Z fricke $
11!
12! 790 2011-11-29 03:11:20Z raasch
13! bugfix: calculation of 'pr' must depend on the particle weighting factor
14!
15! 771 2011-10-27 10:56:21Z heinze
16! +lpt
17!
18! 759 2011-09-15 13:58:31Z raasch
19! Splitting of parallel I/O
20!
21! 729 2011-05-26 10:33:34Z heinze
22! Exchange ghost layers for p regardless of used pressure solver (except SOR).
23!
24! 691 2011-03-04 08:45:30Z maronga
25! Replaced simulated_time by time_since_reference_point
26!
27! 673 2011-01-18 16:19:48Z suehring
28! When using Multigrid or SOR solver an additional CALL exchange_horiz is
29! is needed for pressure output.
30!
31! 667 2010-12-23 12:06:00Z suehring/gryschka
32! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in loops and
33! allocation of arrays local_2d and total_2d.
34! Calls of exchange_horiz are modiefied.
35!
36! 622 2010-12-10 08:08:13Z raasch
37! optional barriers included in order to speed up collective operations
38!
39! 493 2010-03-01 08:30:24Z raasch
40! NetCDF4 support (parallel output)
41!
42! 367 2009-08-25 08:35:52Z maronga
43! simulated_time in NetCDF output replaced by time_since_reference_point.
44! Output of NetCDF messages with aid of message handling routine.
45! Bugfix: averaging along z is not allowed for 2d quantities (e.g. u* and z0)
46! Output of messages replaced by message handling routine.
47! Output of user defined 2D (XY) arrays at z=nzb+1 is now possible
48! Bugfix: to_be_resorted => s_av for time-averaged scalars
49! Calculation of shf* and qsws* added.
50!
51! 215 2008-11-18 09:54:31Z raasch
52! Bugfix: no output of particle concentration and radius unless particles
53! have been started
54!
55! 96 2007-06-04 08:07:41Z raasch
56! Output of density and salinity
57!
58! 75 2007-03-22 09:54:05Z raasch
59! Output of precipitation amount/rate and roughness length,
60! 2nd+3rd argument removed from exchange horiz
61!
62! RCS Log replace by Id keyword, revision history cleaned up
63!
64! Revision 1.5  2006/08/22 13:50:29  raasch
65! xz and yz cross sections now up to nzt+1
66!
67! Revision 1.2  2006/02/23 10:19:22  raasch
68! Output of time-averaged data, output of averages along x, y, or z,
69! output of user-defined quantities,
70! section data are copied from local_pf to local_2d before they are output,
71! output of particle concentration and mean radius,
72! Former subroutine plot_2d renamed data_output_2d, pl2d.. renamed do2d..,
73! anz renamed ngp, ebene renamed section, pl2d_.._anz renamed do2d_.._n
74!
75! Revision 1.1  1997/08/11 06:24:09  raasch
76! Initial revision
77!
78!
79! Description:
80! ------------
81! Data output of horizontal cross-sections in NetCDF format or binary format
82! compatible to old graphic software iso2d.
83! Attention: The position of the sectional planes is still not always computed
84! ---------  correctly. (zu is used always)!
85!------------------------------------------------------------------------------!
86
87    USE arrays_3d
88    USE averaging
89    USE cloud_parameters
90    USE control_parameters
91    USE cpulog
92    USE grid_variables
93    USE indices
94    USE interfaces
95    USE netcdf_control
96    USE particle_attributes
97    USE pegrid
98
99    IMPLICIT NONE
100
101    CHARACTER (LEN=2)  ::  do2d_mode, mode
102    CHARACTER (LEN=4)  ::  grid
103    CHARACTER (LEN=25) ::  section_chr
104    CHARACTER (LEN=50) ::  rtext
105    INTEGER ::  av, ngp, file_id, i, if, is, iis, j, k, l, layer_xy, n, psi, &
106                s, sender, &
107                ind(4)
108    LOGICAL ::  found, resorted, two_d
109    REAL    ::  mean_r, s_r3, s_r4
110    REAL, DIMENSION(:), ALLOCATABLE ::      level_z
111    REAL, DIMENSION(:,:), ALLOCATABLE ::    local_2d, local_2d_l
112    REAL, DIMENSION(:,:,:), ALLOCATABLE ::  local_pf
113#if defined( __parallel )
114    REAL, DIMENSION(:,:),   ALLOCATABLE ::  total_2d
115#endif
116    REAL, DIMENSION(:,:,:), POINTER ::  to_be_resorted
117
118    NAMELIST /LOCAL/  rtext
119
120    CALL cpu_log (log_point(3),'data_output_2d','start')
121
122!
123!-- Immediate return, if no output is requested (no respective sections
124!-- found in parameter data_output)
125    IF ( mode == 'xy'  .AND.  .NOT. data_output_xy(av) )  RETURN
126    IF ( mode == 'xz'  .AND.  .NOT. data_output_xz(av) )  RETURN
127    IF ( mode == 'yz'  .AND.  .NOT. data_output_yz(av) )  RETURN
128
129    two_d = .FALSE.    ! local variable to distinguish between output of pure 2D
130                       ! arrays and cross-sections of 3D arrays.
131
132!
133!-- Depending on the orientation of the cross-section, the respective output
134!-- files have to be opened.
135    SELECT CASE ( mode )
136
137       CASE ( 'xy' )
138          s = 1
139          ALLOCATE( level_z(nzb:nzt+1), local_2d(nxlg:nxrg,nysg:nyng) )
140
141!
142!--       Classic and 64bit offset NetCDF output is done only on PE0.
143!--       netCDF4/HDF5 output is done in parallel on all PEs.
144          IF ( netcdf_output .AND. ( myid == 0 .OR. netcdf_data_format > 2 ) ) &
145          THEN
146             CALL check_open( 101+av*10 )
147          ENDIF
148
149          IF ( data_output_2d_on_each_pe )  THEN
150             CALL check_open( 21 )
151          ELSE
152             IF ( myid == 0 )  THEN
153                IF ( iso2d_output )  CALL check_open( 21 )
154#if defined( __parallel )
155                ALLOCATE( total_2d(-nbgp:nx+nbgp,-nbgp:ny+nbgp) )
156#endif
157             ENDIF
158          ENDIF
159
160       CASE ( 'xz' )
161          s = 2
162          ALLOCATE( local_2d(nxlg:nxrg,nzb:nzt+1) )
163
164!
165!--       Classic and 64bit offset NetCDF output is done only on PE0.
166!--       netCDF4/HDF5 output may be done in parallel on all PEs.
167          IF ( netcdf_output .AND. ( myid == 0 .OR. netcdf_data_format > 2 ) ) &
168          THEN
169             CALL check_open( 102+av*10 )
170          ENDIF
171
172          IF ( data_output_2d_on_each_pe )  THEN
173             CALL check_open( 22 )
174          ELSE
175             IF ( myid == 0 )  THEN
176                IF ( iso2d_output )  CALL check_open( 22 )
177#if defined( __parallel )
178                ALLOCATE( total_2d(-nbgp:nx+nbgp,nzb:nzt+1) )
179#endif
180             ENDIF
181          ENDIF
182
183       CASE ( 'yz' )
184
185          s = 3
186          ALLOCATE( local_2d(nysg:nyng,nzb:nzt+1) )
187
188!
189!--       Classic and 64bit offset NetCDF output is done only on PE0.
190!--       netCDF4/HDF5 output may be done in parallel on all PEs.
191          IF ( netcdf_output .AND. ( myid == 0 .OR. netcdf_data_format > 2 ) ) &
192          THEN
193             CALL check_open( 103+av*10 )
194          ENDIF
195
196          IF ( data_output_2d_on_each_pe )  THEN
197             CALL check_open( 23 )
198          ELSE
199             IF ( myid == 0 )  THEN
200                IF ( iso2d_output )  CALL check_open( 23 )
201#if defined( __parallel )
202                ALLOCATE( total_2d(-nbgp:ny+nbgp,nzb:nzt+1) )
203#endif
204             ENDIF
205          ENDIF
206
207       CASE DEFAULT
208
209          message_string = 'unknown cross-section: ' // TRIM( mode )
210          CALL message( 'data_output_2d', 'PA0180', 1, 2, 0, 6, 0 )
211
212    END SELECT
213
214!
215!-- Allocate a temporary array for resorting (kji -> ijk).
216    ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb:nzt+1) )
217
218!
219!-- Loop of all variables to be written.
220!-- Output dimensions chosen
221    if = 1
222    l = MAX( 2, LEN_TRIM( do2d(av,if) ) )
223    do2d_mode = do2d(av,if)(l-1:l)
224
225    DO  WHILE ( do2d(av,if)(1:1) /= ' ' )
226
227       IF ( do2d_mode == mode )  THEN
228!
229!--       Store the array chosen on the temporary array.
230          resorted = .FALSE.
231          SELECT CASE ( TRIM( do2d(av,if) ) )
232
233             CASE ( 'e_xy', 'e_xz', 'e_yz' )
234                IF ( av == 0 )  THEN
235                   to_be_resorted => e
236                ELSE
237                   to_be_resorted => e_av
238                ENDIF
239                IF ( mode == 'xy' )  level_z = zu
240
241             CASE ( 'lpt_xy', 'lpt_xz', 'lpt_yz' )
242                IF ( av == 0 )  THEN
243                   to_be_resorted => pt
244                ELSE
245                   to_be_resorted => lpt_av
246                ENDIF
247                IF ( mode == 'xy' )  level_z = zu
248
249             CASE ( 'lwp*_xy' )        ! 2d-array
250                IF ( av == 0 )  THEN
251                   DO  i = nxlg, nxrg
252                      DO  j = nysg, nyng
253                         local_pf(i,j,nzb+1) = SUM( ql(nzb:nzt,j,i) * &
254                                                    dzw(1:nzt+1) )
255                      ENDDO
256                   ENDDO
257                ELSE
258                   DO  i = nxlg, nxrg
259                      DO  j = nysg, nyng
260                         local_pf(i,j,nzb+1) = lwp_av(j,i)
261                      ENDDO
262                   ENDDO
263                ENDIF
264                resorted = .TRUE.
265                two_d = .TRUE.
266                level_z(nzb+1) = zu(nzb+1)
267
268             CASE ( 'p_xy', 'p_xz', 'p_yz' )
269                IF ( av == 0 )  THEN
270                   IF ( psolver /= 'sor' )  CALL exchange_horiz( p, nbgp )
271                   to_be_resorted => p
272                ELSE
273                   IF ( psolver /= 'sor' )  CALL exchange_horiz( p_av, nbgp )
274                   to_be_resorted => p_av
275                ENDIF
276                IF ( mode == 'xy' )  level_z = zu
277
278             CASE ( 'pc_xy', 'pc_xz', 'pc_yz' )  ! particle concentration
279                IF ( av == 0 )  THEN
280                   IF ( simulated_time >= particle_advection_start )  THEN
281                      tend = prt_count
282                      CALL exchange_horiz( tend, nbgp )
283                   ELSE
284                      tend = 0.0
285                   ENDIF
286                   DO  i = nxlg, nxrg
287                      DO  j = nysg, nyng
288                         DO  k = nzb, nzt+1
289                            local_pf(i,j,k) = tend(k,j,i)
290                         ENDDO
291                      ENDDO
292                   ENDDO
293                   resorted = .TRUE.
294                ELSE
295                   CALL exchange_horiz( pc_av, nbgp )
296                   to_be_resorted => pc_av
297                ENDIF
298
299             CASE ( 'pr_xy', 'pr_xz', 'pr_yz' )  ! mean particle radius
300                IF ( av == 0 )  THEN
301                   IF ( simulated_time >= particle_advection_start )  THEN
302                      DO  i = nxl, nxr
303                         DO  j = nys, nyn
304                            DO  k = nzb, nzt+1
305                               psi = prt_start_index(k,j,i)
306                               s_r3 = 0.0
307                               s_r4 = 0.0
308                               DO  n = psi, psi+prt_count(k,j,i)-1
309                                  s_r3 = s_r3 + particles(n)%radius**3 * &
310                                                particles(n)%weight_factor
311                                  s_r4 = s_r4 + particles(n)%radius**4 * &
312                                                particles(n)%weight_factor
313                               ENDDO
314                               IF ( s_r3 /= 0.0 )  THEN
315                                  mean_r = s_r4 / s_r3
316                               ELSE
317                                  mean_r = 0.0
318                               ENDIF
319                               tend(k,j,i) = mean_r
320                            ENDDO
321                         ENDDO
322                      ENDDO
323                      CALL exchange_horiz( tend, nbgp )
324                   ELSE
325                      tend = 0.0
326                   END IF
327                   DO  i = nxlg, nxrg
328                      DO  j = nysg, nyng
329                         DO  k = nzb, nzt+1
330                            local_pf(i,j,k) = tend(k,j,i)
331                         ENDDO
332                      ENDDO
333                   ENDDO
334                   resorted = .TRUE.
335                ELSE
336                   CALL exchange_horiz( pr_av, nbgp )
337                   to_be_resorted => pr_av
338                ENDIF
339
340             CASE ( 'pra*_xy' )        ! 2d-array / integral quantity => no av
341                CALL exchange_horiz_2d( precipitation_amount )
342                   DO  i = nxlg, nxrg
343                      DO  j = nysg, nyng
344                      local_pf(i,j,nzb+1) =  precipitation_amount(j,i)
345                   ENDDO
346                ENDDO
347                precipitation_amount = 0.0   ! reset for next integ. interval
348                resorted = .TRUE.
349                two_d = .TRUE.
350                level_z(nzb+1) = zu(nzb+1)
351
352             CASE ( 'prr*_xy' )        ! 2d-array
353                IF ( av == 0 )  THEN
354                   CALL exchange_horiz_2d( precipitation_rate )
355                   DO  i = nxlg, nxrg
356                      DO  j = nysg, nyng
357                         local_pf(i,j,nzb+1) =  precipitation_rate(j,i)
358                      ENDDO
359                   ENDDO
360                ELSE
361                   CALL exchange_horiz_2d( precipitation_rate_av )
362                   DO  i = nxlg, nxrg
363                      DO  j = nysg, nyng
364                         local_pf(i,j,nzb+1) =  precipitation_rate_av(j,i)
365                      ENDDO
366                   ENDDO
367                ENDIF
368                resorted = .TRUE.
369                two_d = .TRUE.
370                level_z(nzb+1) = zu(nzb+1)
371
372             CASE ( 'pt_xy', 'pt_xz', 'pt_yz' )
373                IF ( av == 0 )  THEN
374                   IF ( .NOT. cloud_physics ) THEN
375                      to_be_resorted => pt
376                   ELSE
377                   DO  i = nxlg, nxrg
378                      DO  j = nysg, nyng
379                            DO  k = nzb, nzt+1
380                               local_pf(i,j,k) = pt(k,j,i) + l_d_cp *    &
381                                                             pt_d_t(k) * &
382                                                             ql(k,j,i)
383                            ENDDO
384                         ENDDO
385                      ENDDO
386                      resorted = .TRUE.
387                   ENDIF
388                ELSE
389                   to_be_resorted => pt_av
390                ENDIF
391                IF ( mode == 'xy' )  level_z = zu
392
393             CASE ( 'q_xy', 'q_xz', 'q_yz' )
394                IF ( av == 0 )  THEN
395                   to_be_resorted => q
396                ELSE
397                   to_be_resorted => q_av
398                ENDIF
399                IF ( mode == 'xy' )  level_z = zu
400
401             CASE ( 'ql_xy', 'ql_xz', 'ql_yz' )
402                IF ( av == 0 )  THEN
403                   to_be_resorted => ql
404                ELSE
405                   to_be_resorted => ql_av
406                ENDIF
407                IF ( mode == 'xy' )  level_z = zu
408
409             CASE ( 'ql_c_xy', 'ql_c_xz', 'ql_c_yz' )
410                IF ( av == 0 )  THEN
411                   to_be_resorted => ql_c
412                ELSE
413                   to_be_resorted => ql_c_av
414                ENDIF
415                IF ( mode == 'xy' )  level_z = zu
416
417             CASE ( 'ql_v_xy', 'ql_v_xz', 'ql_v_yz' )
418                IF ( av == 0 )  THEN
419                   to_be_resorted => ql_v
420                ELSE
421                   to_be_resorted => ql_v_av
422                ENDIF
423                IF ( mode == 'xy' )  level_z = zu
424
425             CASE ( 'ql_vp_xy', 'ql_vp_xz', 'ql_vp_yz' )
426                IF ( av == 0 )  THEN
427                   to_be_resorted => ql_vp
428                ELSE
429                   to_be_resorted => ql_vp_av
430                ENDIF
431                IF ( mode == 'xy' )  level_z = zu
432
433             CASE ( 'qsws*_xy' )        ! 2d-array
434                IF ( av == 0 ) THEN
435                   DO  i = nxlg, nxrg
436                      DO  j = nysg, nyng
437                         local_pf(i,j,nzb+1) =  qsws(j,i)
438                      ENDDO
439                   ENDDO
440                ELSE
441                   DO  i = nxlg, nxrg
442                      DO  j = nysg, nyng 
443                         local_pf(i,j,nzb+1) =  qsws_av(j,i)
444                      ENDDO
445                   ENDDO
446                ENDIF
447                resorted = .TRUE.
448                two_d = .TRUE.
449                level_z(nzb+1) = zu(nzb+1)
450
451             CASE ( 'qv_xy', 'qv_xz', 'qv_yz' )
452                IF ( av == 0 )  THEN
453                   DO  i = nxlg, nxrg
454                      DO  j = nysg, nyng
455                         DO  k = nzb, nzt+1
456                            local_pf(i,j,k) = q(k,j,i) - ql(k,j,i)
457                         ENDDO
458                      ENDDO
459                   ENDDO
460                   resorted = .TRUE.
461                ELSE
462                   to_be_resorted => qv_av
463                ENDIF
464                IF ( mode == 'xy' )  level_z = zu
465
466             CASE ( 'rho_xy', 'rho_xz', 'rho_yz' )
467                IF ( av == 0 )  THEN
468                   to_be_resorted => rho
469                ELSE
470                   to_be_resorted => rho_av
471                ENDIF
472
473             CASE ( 's_xy', 's_xz', 's_yz' )
474                IF ( av == 0 )  THEN
475                   to_be_resorted => q
476                ELSE
477                   to_be_resorted => s_av
478                ENDIF
479
480             CASE ( 'sa_xy', 'sa_xz', 'sa_yz' )
481                IF ( av == 0 )  THEN
482                   to_be_resorted => sa
483                ELSE
484                   to_be_resorted => sa_av
485                ENDIF
486
487             CASE ( 'shf*_xy' )        ! 2d-array
488                IF ( av == 0 ) THEN
489                   DO  i = nxlg, nxrg
490                      DO  j = nysg, nyng
491                         local_pf(i,j,nzb+1) =  shf(j,i)
492                      ENDDO
493                   ENDDO
494                ELSE
495                   DO  i = nxlg, nxrg
496                      DO  j = nysg, nyng
497                         local_pf(i,j,nzb+1) =  shf_av(j,i)
498                      ENDDO
499                   ENDDO
500                ENDIF
501                resorted = .TRUE.
502                two_d = .TRUE.
503                level_z(nzb+1) = zu(nzb+1)
504
505             CASE ( 't*_xy' )        ! 2d-array
506                IF ( av == 0 )  THEN
507                   DO  i = nxlg, nxrg
508                      DO  j = nysg, nyng
509                         local_pf(i,j,nzb+1) = ts(j,i)
510                      ENDDO
511                   ENDDO
512                ELSE
513                   DO  i = nxlg, nxrg
514                      DO  j = nysg, nyng
515                         local_pf(i,j,nzb+1) = ts_av(j,i)
516                      ENDDO
517                   ENDDO
518                ENDIF
519                resorted = .TRUE.
520                two_d = .TRUE.
521                level_z(nzb+1) = zu(nzb+1)
522
523             CASE ( 'u_xy', 'u_xz', 'u_yz' )
524                IF ( av == 0 )  THEN
525                   to_be_resorted => u
526                ELSE
527                   to_be_resorted => u_av
528                ENDIF
529                IF ( mode == 'xy' )  level_z = zu
530!
531!--             Substitute the values generated by "mirror" boundary condition
532!--             at the bottom boundary by the real surface values.
533                IF ( do2d(av,if) == 'u_xz'  .OR.  do2d(av,if) == 'u_yz' )  THEN
534                   IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0
535                ENDIF
536
537             CASE ( 'u*_xy' )        ! 2d-array
538                IF ( av == 0 )  THEN
539                   DO  i = nxlg, nxrg
540                      DO  j = nysg, nyng
541                         local_pf(i,j,nzb+1) = us(j,i)
542                      ENDDO
543                   ENDDO
544                ELSE
545                   DO  i = nxlg, nxrg
546                      DO  j = nysg, nyng
547                         local_pf(i,j,nzb+1) = us_av(j,i)
548                      ENDDO
549                   ENDDO
550                ENDIF
551                resorted = .TRUE.
552                two_d = .TRUE.
553                level_z(nzb+1) = zu(nzb+1)
554
555             CASE ( 'v_xy', 'v_xz', 'v_yz' )
556                IF ( av == 0 )  THEN
557                   to_be_resorted => v
558                ELSE
559                   to_be_resorted => v_av
560                ENDIF
561                IF ( mode == 'xy' )  level_z = zu
562!
563!--             Substitute the values generated by "mirror" boundary condition
564!--             at the bottom boundary by the real surface values.
565                IF ( do2d(av,if) == 'v_xz'  .OR.  do2d(av,if) == 'v_yz' )  THEN
566                   IF ( ibc_uv_b == 0 )  local_pf(:,:,nzb) = 0.0
567                ENDIF
568
569             CASE ( 'vpt_xy', 'vpt_xz', 'vpt_yz' )
570                IF ( av == 0 )  THEN
571                   to_be_resorted => vpt
572                ELSE
573                   to_be_resorted => vpt_av
574                ENDIF
575                IF ( mode == 'xy' )  level_z = zu
576
577             CASE ( 'w_xy', 'w_xz', 'w_yz' )
578                IF ( av == 0 )  THEN
579                   to_be_resorted => w
580                ELSE
581                   to_be_resorted => w_av
582                ENDIF
583                IF ( mode == 'xy' )  level_z = zw
584
585             CASE ( 'z0*_xy' )        ! 2d-array
586                IF ( av == 0 ) THEN
587                   DO  i = nxlg, nxrg
588                      DO  j = nysg, nyng
589                         local_pf(i,j,nzb+1) =  z0(j,i)
590                      ENDDO
591                   ENDDO
592                ELSE
593                   DO  i = nxlg, nxrg
594                      DO  j = nysg, nyng
595                         local_pf(i,j,nzb+1) =  z0_av(j,i)
596                      ENDDO
597                   ENDDO
598                ENDIF
599                resorted = .TRUE.
600                two_d = .TRUE.
601                level_z(nzb+1) = zu(nzb+1)
602
603             CASE ( 'z0h*_xy' )        ! 2d-array
604                IF ( av == 0 ) THEN
605                   DO  i = nxlg, nxrg
606                      DO  j = nysg, nyng
607                         local_pf(i,j,nzb+1) =  z0h(j,i)
608                      ENDDO
609                   ENDDO
610                ELSE
611                   DO  i = nxlg, nxrg
612                      DO  j = nysg, nyng
613                         local_pf(i,j,nzb+1) =  z0h_av(j,i)
614                      ENDDO
615                   ENDDO
616                ENDIF
617                resorted = .TRUE.
618                two_d = .TRUE.
619                level_z(nzb+1) = zu(nzb+1)
620
621             CASE DEFAULT
622!
623!--             User defined quantity
624                CALL user_data_output_2d( av, do2d(av,if), found, grid, &
625                                          local_pf, two_d )
626                resorted = .TRUE.
627
628                IF ( grid == 'zu' )  THEN
629                   IF ( mode == 'xy' )  level_z = zu
630                ELSEIF ( grid == 'zw' )  THEN
631                   IF ( mode == 'xy' )  level_z = zw
632                ELSEIF ( grid == 'zu1' ) THEN
633                   IF ( mode == 'xy' )  level_z(nzb+1) = zu(nzb+1)
634                ENDIF
635
636                IF ( .NOT. found )  THEN
637                   message_string = 'no output provided for: ' //    &
638                                    TRIM( do2d(av,if) )
639                   CALL message( 'data_output_2d', 'PA0181', 0, 0, 0, 6, 0 )
640                ENDIF
641
642          END SELECT
643
644!
645!--       Resort the array to be output, if not done above
646          IF ( .NOT. resorted )  THEN
647             DO  i = nxlg, nxrg
648                DO  j = nysg, nyng
649                   DO  k = nzb, nzt+1
650                      local_pf(i,j,k) = to_be_resorted(k,j,i)
651                   ENDDO
652                ENDDO
653             ENDDO
654          ENDIF
655
656!
657!--       Output of the individual cross-sections, depending on the cross-
658!--       section mode chosen.
659          is = 1
660   loop1: DO  WHILE ( section(is,s) /= -9999  .OR.  two_d )
661
662             SELECT CASE ( mode )
663
664                CASE ( 'xy' )
665!
666!--                Determine the cross section index
667                   IF ( two_d )  THEN
668                      layer_xy = nzb+1
669                   ELSE
670                      layer_xy = section(is,s)
671                   ENDIF
672
673!
674!--                Update the NetCDF xy cross section time axis
675                   IF ( myid == 0  .OR.  netcdf_data_format > 2 )  THEN
676                      IF ( simulated_time /= do2d_xy_last_time(av) )  THEN
677                         do2d_xy_time_count(av) = do2d_xy_time_count(av) + 1
678                         do2d_xy_last_time(av)  = simulated_time
679                         IF ( ( .NOT. data_output_2d_on_each_pe  .AND. &
680                              netcdf_output )  .OR.  netcdf_data_format > 2 ) &
681                         THEN
682#if defined( __netcdf )
683                            nc_stat = NF90_PUT_VAR( id_set_xy(av),             &
684                                                    id_var_time_xy(av),        &
685                                             (/ time_since_reference_point /), &
686                                         start = (/ do2d_xy_time_count(av) /), &
687                                                    count = (/ 1 /) )
688                            CALL handle_netcdf_error( 'data_output_2d', 53 )
689#endif
690                         ENDIF
691                      ENDIF
692                   ENDIF
693!
694!--                If required, carry out averaging along z
695                   IF ( section(is,s) == -1  .AND.  .NOT. two_d )  THEN
696
697                      local_2d = 0.0
698!
699!--                   Carry out the averaging (all data are on the PE)
700                      DO  k = nzb, nzt+1
701                         DO  j = nysg, nyng
702                            DO  i = nxlg, nxrg
703                               local_2d(i,j) = local_2d(i,j) + local_pf(i,j,k)
704                            ENDDO
705                         ENDDO
706                      ENDDO
707
708                      local_2d = local_2d / ( nzt -nzb + 2.0)
709
710                   ELSE
711!
712!--                   Just store the respective section on the local array
713                      local_2d = local_pf(:,:,layer_xy)
714
715                   ENDIF
716
717#if defined( __parallel )
718                   IF ( netcdf_output  .AND.  netcdf_data_format > 2 )  THEN
719!
720!--                   Output in NetCDF4/HDF5 format.
721!--                   Do not output redundant ghost point data except for the
722!--                   boundaries of the total domain.
723                      IF ( two_d ) THEN
724                         iis = 1
725                      ELSE
726                         iis = is
727                      ENDIF
728
729#if defined( __netcdf )
730                      IF ( nxr == nx  .AND.  nyn /= ny )  THEN
731                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
732                                                 id_var_do2d(av,if),           &
733                                                 local_2d(nxl:nxr+1,nys:nyn),  &
734                                                 start = (/ nxl+1, nys+1, iis, &
735                                                    do2d_xy_time_count(av) /), &
736                                                 count = (/ nxr-nxl+2,         &
737                                                            nyn-nys+1, 1, 1 /) )
738                      ELSEIF ( nxr /= nx  .AND.  nyn == ny )  THEN
739                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
740                                                 id_var_do2d(av,if),           &
741                                                 local_2d(nxl:nxr,nys:nyn+1),  &
742                                                 start = (/ nxl+1, nys+1, iis, &
743                                                    do2d_xy_time_count(av) /), &
744                                                 count = (/ nxr-nxl+1,         &
745                                                            nyn-nys+2, 1, 1 /) )
746                      ELSEIF ( nxr == nx  .AND.  nyn == ny )  THEN
747                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
748                                                 id_var_do2d(av,if),           &
749                                                 local_2d(nxl:nxr+1,nys:nyn+1),&
750                                                 start = (/ nxl+1, nys+1, iis, &
751                                                    do2d_xy_time_count(av) /), &
752                                                 count = (/ nxr-nxl+2,          &
753                                                            nyn-nys+2, 1, 1 /) )
754                      ELSE
755                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
756                                                 id_var_do2d(av,if),           &
757                                                 local_2d(nxl:nxr,nys:nyn),    &
758                                                 start = (/ nxl+1, nys+1, iis, &
759                                                    do2d_xy_time_count(av) /), &
760                                                 count = (/ nxr-nxl+1,         &
761                                                            nyn-nys+1, 1, 1 /) )
762                      ENDIF
763
764                      CALL handle_netcdf_error( 'data_output_2d', 55 )
765#endif
766                   ELSE
767
768                      IF ( data_output_2d_on_each_pe )  THEN
769!
770!--                      Output of partial arrays on each PE
771#if defined( __netcdf )
772                         IF ( netcdf_output  .AND.  myid == 0 )  THEN
773                            WRITE ( 21 )  time_since_reference_point, &
774                                          do2d_xy_time_count(av), av
775                         ENDIF
776#endif
777                         DO  i = 0, io_blocks-1
778                            IF ( i == io_group )  THEN
779                               WRITE ( 21 )  nxlg, nxrg, nysg, nyng
780                               WRITE ( 21 )  local_2d
781                            ENDIF
782#if defined( __parallel )
783                            CALL MPI_BARRIER( comm2d, ierr )
784#endif
785                         ENDDO
786
787                      ELSE
788!
789!--                      PE0 receives partial arrays from all processors and
790!--                      then outputs them. Here a barrier has to be set,
791!--                      because otherwise "-MPI- FATAL: Remote protocol queue
792!--                      full" may occur.
793                         CALL MPI_BARRIER( comm2d, ierr )
794
795                         ngp = ( nxrg-nxlg+1 ) * ( nyng-nysg+1 )
796                         IF ( myid == 0 )  THEN
797!
798!--                         Local array can be relocated directly.
799                            total_2d(nxlg:nxrg,nysg:nyng) = local_2d
800!
801!--                         Receive data from all other PEs.
802                            DO  n = 1, numprocs-1
803!
804!--                            Receive index limits first, then array.
805!--                            Index limits are received in arbitrary order from
806!--                            the PEs.
807                               CALL MPI_RECV( ind(1), 4, MPI_INTEGER,    &
808                                              MPI_ANY_SOURCE, 0, comm2d, &
809                                              status, ierr )
810                               sender = status(MPI_SOURCE)
811                               DEALLOCATE( local_2d )
812                               ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) )
813                               CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp,  &
814                                              MPI_REAL, sender, 1, comm2d,   &
815                                              status, ierr )
816                               total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d
817                            ENDDO
818!
819!--                         Output of the total cross-section.
820                            IF ( iso2d_output )  THEN
821                               WRITE (21)  total_2d(-nbgp:nx+nbgp,-nbgp:ny+nbgp)
822                            ENDIF
823!
824!--                         Relocate the local array for the next loop increment
825                            DEALLOCATE( local_2d )
826                            ALLOCATE( local_2d(nxlg:nxrg,nysg:nyng) )
827
828#if defined( __netcdf )
829                            IF ( netcdf_output )  THEN
830                               IF ( two_d ) THEN
831                                  nc_stat = NF90_PUT_VAR( id_set_xy(av),       &
832                                                          id_var_do2d(av,if),  &
833                                                      total_2d(0:nx+1,0:ny+1), &
834                                start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
835                                                count = (/ nx+2, ny+2, 1, 1 /) )
836                               ELSE
837                                  nc_stat = NF90_PUT_VAR( id_set_xy(av),       &
838                                                          id_var_do2d(av,if),  &
839                                                      total_2d(0:nx+1,0:ny+1), &
840                               start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
841                                                count = (/ nx+2, ny+2, 1, 1 /) )
842                               ENDIF
843                               CALL handle_netcdf_error( 'data_output_2d', 54 )
844                            ENDIF
845#endif
846
847                         ELSE
848!
849!--                         First send the local index limits to PE0
850                            ind(1) = nxlg; ind(2) = nxrg
851                            ind(3) = nysg; ind(4) = nyng
852                            CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
853                                           comm2d, ierr )
854!
855!--                         Send data to PE0
856                            CALL MPI_SEND( local_2d(nxlg,nysg), ngp, &
857                                           MPI_REAL, 0, 1, comm2d, ierr )
858                         ENDIF
859!
860!--                      A barrier has to be set, because otherwise some PEs may
861!--                      proceed too fast so that PE0 may receive wrong data on
862!--                      tag 0
863                         CALL MPI_BARRIER( comm2d, ierr )
864                      ENDIF
865
866                   ENDIF
867#else
868                   IF ( iso2d_output )  THEN
869                      WRITE (21)  local_2d(nxl:nxr+1,nys:nyn+1)
870                   ENDIF
871#if defined( __netcdf )
872                   IF ( netcdf_output )  THEN
873                      IF ( two_d ) THEN
874                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
875                                                 id_var_do2d(av,if),           &
876                                                local_2d(nxl:nxr+1,nys:nyn+1), &
877                                start = (/ 1, 1, 1, do2d_xy_time_count(av) /), &
878                                              count = (/ nx+2, ny+2, 1, 1 /) )
879                      ELSE
880                         nc_stat = NF90_PUT_VAR( id_set_xy(av),                &
881                                                 id_var_do2d(av,if),           &
882                                                local_2d(nxl:nxr+1,nys:nyn+1), &
883                               start = (/ 1, 1, is, do2d_xy_time_count(av) /), &
884                                              count = (/ nx+2, ny+2, 1, 1 /) )
885                      ENDIF
886                      CALL handle_netcdf_error( 'data_output_2d', 447 )
887                   ENDIF
888#endif
889#endif
890                   do2d_xy_n = do2d_xy_n + 1
891!
892!--                Write LOCAL parameter set for ISO2D.
893                   IF ( myid == 0  .AND.  iso2d_output )  THEN
894                      IF ( section(is,s) /= -1 )  THEN
895                         WRITE ( section_chr, '(''z = '',F7.2,'' m  (GP '',I3, &
896                                               &'')'')'                        &
897                               )  level_z(layer_xy), layer_xy
898                      ELSE
899                         section_chr = 'averaged along z'
900                      ENDIF
901                      IF ( av == 0 )  THEN
902                         rtext = TRIM( do2d(av,if) ) // '  t = ' //    &
903                                 TRIM( simulated_time_chr ) // '  ' // &
904                                 TRIM( section_chr )
905                      ELSE
906                         rtext = TRIM( do2d(av,if) ) // '  averaged t = ' // &
907                                 TRIM( simulated_time_chr ) // '  ' //       &
908                                 TRIM( section_chr )
909                      ENDIF
910                      WRITE (27,LOCAL)
911                   ENDIF
912!
913!--                For 2D-arrays (e.g. u*) only one cross-section is available.
914!--                Hence exit loop of output levels.
915                   IF ( two_d )  THEN
916                      two_d = .FALSE.
917                      EXIT loop1
918                   ENDIF
919
920                CASE ( 'xz' )
921!
922!--                Update the NetCDF xz cross section time axis
923                   IF ( myid == 0  .OR.  netcdf_data_format > 2 )  THEN
924
925                      IF ( simulated_time /= do2d_xz_last_time(av) )  THEN
926                         do2d_xz_time_count(av) = do2d_xz_time_count(av) + 1
927                         do2d_xz_last_time(av)  = simulated_time
928                         IF ( ( .NOT. data_output_2d_on_each_pe  .AND.        &
929                              netcdf_output )  .OR.  netcdf_data_format > 2 ) &
930                         THEN
931#if defined( __netcdf )
932                            nc_stat = NF90_PUT_VAR( id_set_xz(av),             &
933                                                    id_var_time_xz(av),        &
934                                             (/ time_since_reference_point /), &
935                                         start = (/ do2d_xz_time_count(av) /), &
936                                                    count = (/ 1 /) )
937                            CALL handle_netcdf_error( 'data_output_2d', 56 )
938#endif
939                         ENDIF
940                      ENDIF
941
942                   ENDIF
943
944!
945!--                If required, carry out averaging along y
946                   IF ( section(is,s) == -1 )  THEN
947
948                      ALLOCATE( local_2d_l(nxlg:nxrg,nzb:nzt+1) )
949                      local_2d_l = 0.0
950                      ngp = ( nxrg-nxlg+1 ) * ( nzt-nzb+2 )
951!
952!--                   First local averaging on the PE
953                      DO  k = nzb, nzt+1
954                         DO  j = nys, nyn
955                            DO  i = nxlg, nxrg
956                               local_2d_l(i,k) = local_2d_l(i,k) + &
957                                                 local_pf(i,j,k)
958                            ENDDO
959                         ENDDO
960                      ENDDO
961#if defined( __parallel )
962!
963!--                   Now do the averaging over all PEs along y
964                      IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
965                      CALL MPI_ALLREDUCE( local_2d_l(nxlg,nzb),              &
966                                          local_2d(nxlg,nzb), ngp, MPI_REAL, &
967                                          MPI_SUM, comm1dy, ierr )
968#else
969                      local_2d = local_2d_l
970#endif
971                      local_2d = local_2d / ( ny + 1.0 )
972
973                      DEALLOCATE( local_2d_l )
974
975                   ELSE
976!
977!--                   Just store the respective section on the local array
978!--                   (but only if it is available on this PE!)
979                      IF ( section(is,s) >= nys  .AND.  section(is,s) <= nyn ) &
980                      THEN
981                         local_2d = local_pf(:,section(is,s),nzb:nzt+1)
982                      ENDIF
983
984                   ENDIF
985
986#if defined( __parallel )
987                   IF ( netcdf_output  .AND.  netcdf_data_format > 2 )  THEN
988!
989!--                   ATTENTION: The following lines are a workaround, because
990!--                              independet output does not work with the
991!--                              current NetCDF4 installation. Therefore, data
992!--                              are transferred from PEs having the cross
993!--                              sections to other PEs along y having no cross
994!--                              section data. Some of these data are the
995!--                              output.
996!--                   BEGIN WORKAROUND---------------------------------------
997                      IF ( npey /= 1  .AND.  section(is,s) /= -1)  THEN
998                         ALLOCATE( local_2d_l(nxlg:nxrg,nzb:nzt+1) )
999                         local_2d_l = 0.0
1000                         IF ( section(is,s) >= nys .AND. section(is,s) <= nyn )&
1001                         THEN
1002                            local_2d_l = local_2d
1003                         ENDIF
1004#if defined( __parallel )
1005!
1006!--                      Distribute data over all PEs along y
1007                         ngp = ( nxrg-nxlg+1 ) * ( nzt-nzb+2 )
1008                         IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
1009                         CALL MPI_ALLREDUCE( local_2d_l(nxlg,nzb),            &
1010                                             local_2d(nxlg,nzb), ngp,         &
1011                                             MPI_REAL, MPI_SUM, comm1dy, ierr )
1012#else
1013                         local_2d = local_2d_l
1014#endif
1015                         DEALLOCATE( local_2d_l )
1016                      ENDIF
1017!--                   END WORKAROUND-----------------------------------------
1018
1019!
1020!--                   Output in NetCDF4/HDF5 format.
1021!--                   Output only on those PEs where the respective cross
1022!--                   sections reside. Cross sections averaged along y are
1023!--                   output on the respective first PE along y (myidy=0).
1024                      IF ( ( section(is,s) >= nys  .AND.  &
1025                             section(is,s) <= nyn )  .OR.  &
1026                           ( section(is,s) == -1  .AND.  myidy == 0 ) )  THEN
1027!
1028!--                      Do not output redundant ghost point data except for the
1029!--                      boundaries of the total domain.
1030#if defined( __netcdf )
1031                         IF ( nxr == nx )  THEN
1032                            nc_stat = NF90_PUT_VAR( id_set_xz(av),             &
1033                                                id_var_do2d(av,if),            &
1034                                                local_2d(nxl:nxr+1,nzb:nzt+1), &
1035                                                start = (/ nxl+1, is, 1,       &
1036                                                    do2d_xz_time_count(av) /), &
1037                                                count = (/ nxr-nxl+2, 1,       &
1038                                                           nzt+2, 1 /) )
1039                         ELSE
1040                            nc_stat = NF90_PUT_VAR( id_set_xz(av),             &
1041                                                id_var_do2d(av,if),            &
1042                                                local_2d(nxl:nxr,nzb:nzt+1),   &
1043                                                start = (/ nxl+1, is, 1,       &
1044                                                    do2d_xz_time_count(av) /), &
1045                                                count = (/ nxr-nxl+1, 1,       &
1046                                                           nzt+2, 1 /) )
1047                         ENDIF
1048
1049                         CALL handle_netcdf_error( 'data_output_2d', 57 )
1050
1051                      ELSE
1052!
1053!--                      Output on other PEs. Only one point is output!!
1054!--                      ATTENTION: This is a workaround (see above)!!
1055                         IF ( npey /= 1 )  THEN
1056                            nc_stat = NF90_PUT_VAR( id_set_xz(av),             &
1057                                                    id_var_do2d(av,if),        &
1058                                                    local_2d(nxl:nxl,nzb:nzb), &
1059                                                    start = (/ nxl+1, is, 1,   &
1060                                                    do2d_xz_time_count(av) /), &
1061                                                    count = (/ 1, 1, 1, 1 /) )
1062                            CALL handle_netcdf_error( 'data_output_2d', 451 )
1063                         ENDIF
1064#endif
1065                      ENDIF
1066
1067                   ELSE
1068
1069                      IF ( data_output_2d_on_each_pe )  THEN
1070!
1071!--                      Output of partial arrays on each PE. If the cross
1072!--                      section does not reside on the PE, output special
1073!--                      index values.
1074#if defined( __netcdf )
1075                         IF ( netcdf_output  .AND.  myid == 0 )  THEN
1076                            WRITE ( 22 )  time_since_reference_point, &
1077                                          do2d_xz_time_count(av), av
1078                         ENDIF
1079#endif
1080                         DO  i = 0, io_blocks-1
1081                            IF ( i == io_group )  THEN
1082                               IF ( ( section(is,s) >= nys  .AND.   &
1083                                      section(is,s) <= nyn )  .OR.  &
1084                                    ( section(is,s) == -1  .AND.    &
1085                                      nys-1 == -1 ) )               &
1086                               THEN
1087                                  WRITE (22)  nxlg, nxrg, nzb, nzt+1
1088                                  WRITE (22)  local_2d
1089                               ELSE
1090                                  WRITE (22)  -1, -1, -1, -1
1091                               ENDIF
1092                            ENDIF
1093#if defined( __parallel )
1094                            CALL MPI_BARRIER( comm2d, ierr )
1095#endif
1096                         ENDDO
1097
1098                      ELSE
1099!
1100!--                      PE0 receives partial arrays from all processors of the
1101!--                      respective cross section and outputs them. Here a
1102!--                      barrier has to be set, because otherwise
1103!--                      "-MPI- FATAL: Remote protocol queue full" may occur.
1104                         CALL MPI_BARRIER( comm2d, ierr )
1105
1106                         ngp = ( nxrg-nxlg+1 ) * ( nzt-nzb+2 )
1107                         IF ( myid == 0 )  THEN
1108!
1109!--                         Local array can be relocated directly.
1110                            IF ( ( section(is,s) >= nys  .AND.                 &
1111                                   section(is,s) <= nyn )  .OR.                &
1112                                 ( section(is,s) == -1  .AND.  nys-1 == -1 ) ) &
1113                            THEN
1114                               total_2d(nxlg:nxrg,nzb:nzt+1) = local_2d
1115                            ENDIF
1116!
1117!--                         Receive data from all other PEs.
1118                            DO  n = 1, numprocs-1
1119!
1120!--                            Receive index limits first, then array.
1121!--                            Index limits are received in arbitrary order from
1122!--                            the PEs.
1123                               CALL MPI_RECV( ind(1), 4, MPI_INTEGER,     &
1124                                              MPI_ANY_SOURCE, 0, comm2d,  &
1125                                              status, ierr )
1126!
1127!--                            Not all PEs have data for XZ-cross-section.
1128                               IF ( ind(1) /= -9999 )  THEN
1129                                  sender = status(MPI_SOURCE)
1130                                  DEALLOCATE( local_2d )
1131                                  ALLOCATE( local_2d(ind(1):ind(2), &
1132                                                     ind(3):ind(4)) )
1133                                  CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
1134                                                 MPI_REAL, sender, 1, comm2d,  &
1135                                                 status, ierr )
1136                                  total_2d(ind(1):ind(2),ind(3):ind(4)) = &
1137                                                                        local_2d
1138                               ENDIF
1139                            ENDDO
1140!
1141!--                         Output of the total cross-section.
1142                            IF ( iso2d_output )  THEN
1143                               WRITE (22)  total_2d(-nbgp:nx+nbgp,nzb:nzt+1)
1144                            ENDIF
1145!
1146!--                         Relocate the local array for the next loop increment
1147                            DEALLOCATE( local_2d )
1148                            ALLOCATE( local_2d(nxlg:nxrg,nzb:nzt+1) )
1149
1150#if defined( __netcdf )
1151                            IF ( netcdf_output )  THEN
1152                               nc_stat = NF90_PUT_VAR( id_set_xz(av),          &
1153                                                    id_var_do2d(av,if),        &
1154                                                    total_2d(0:nx+1,nzb:nzt+1),&
1155                               start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
1156                                                count = (/ nx+2, 1, nz+2, 1 /) )
1157                               CALL handle_netcdf_error( 'data_output_2d', 58 )
1158                            ENDIF
1159#endif
1160
1161                         ELSE
1162!
1163!--                         If the cross section resides on the PE, send the
1164!--                         local index limits, otherwise send -9999 to PE0.
1165                            IF ( ( section(is,s) >= nys  .AND.                 &
1166                                   section(is,s) <= nyn )  .OR.                &
1167                                 ( section(is,s) == -1  .AND.  nys-1 == -1 ) ) &
1168                            THEN
1169                               ind(1) = nxlg; ind(2) = nxrg
1170                               ind(3) = nzb;   ind(4) = nzt+1
1171                            ELSE
1172                               ind(1) = -9999; ind(2) = -9999
1173                               ind(3) = -9999; ind(4) = -9999
1174                            ENDIF
1175                            CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
1176                                           comm2d, ierr )
1177!
1178!--                         If applicable, send data to PE0.
1179                            IF ( ind(1) /= -9999 )  THEN
1180                               CALL MPI_SEND( local_2d(nxlg,nzb), ngp, &
1181                                              MPI_REAL, 0, 1, comm2d, ierr )
1182                            ENDIF
1183                         ENDIF
1184!
1185!--                      A barrier has to be set, because otherwise some PEs may
1186!--                      proceed too fast so that PE0 may receive wrong data on
1187!--                      tag 0
1188                         CALL MPI_BARRIER( comm2d, ierr )
1189                      ENDIF
1190
1191                   ENDIF
1192#else
1193                   IF ( iso2d_output )  THEN
1194                      WRITE (22)  local_2d(nxl:nxr+1,nzb:nzt+1)
1195                   ENDIF
1196#if defined( __netcdf )
1197                   IF ( netcdf_output )  THEN
1198                      nc_stat = NF90_PUT_VAR( id_set_xz(av),                   &
1199                                              id_var_do2d(av,if),              &
1200                                              local_2d(nxl:nxr+1,nzb:nzt+1),   &
1201                               start = (/ 1, is, 1, do2d_xz_time_count(av) /), &
1202                                              count = (/ nx+2, 1, nz+2, 1 /) )
1203                      CALL handle_netcdf_error( 'data_output_2d', 451 )
1204                   ENDIF
1205#endif
1206#endif
1207                   do2d_xz_n = do2d_xz_n + 1
1208!
1209!--                Write LOCAL-parameter set for ISO2D.
1210                   IF ( myid == 0  .AND.  iso2d_output )  THEN
1211                      IF ( section(is,s) /= -1 )  THEN
1212                         WRITE ( section_chr, '(''y = '',F8.2,'' m  (GP '',I3, &
1213                                               &'')'')'                        &
1214                               )  section(is,s)*dy, section(is,s)
1215                      ELSE
1216                         section_chr = 'averaged along y'
1217                      ENDIF
1218                      IF ( av == 0 )  THEN
1219                         rtext = TRIM( do2d(av,if) ) // '  t = ' //    &
1220                                 TRIM( simulated_time_chr ) // '  ' // &
1221                                 TRIM( section_chr )
1222                      ELSE
1223                         rtext = TRIM( do2d(av,if) ) // '  averaged t = ' // &
1224                                 TRIM( simulated_time_chr ) // '  ' //       &
1225                                 TRIM( section_chr )
1226                      ENDIF
1227                      WRITE (28,LOCAL)
1228                   ENDIF
1229
1230                CASE ( 'yz' )
1231!
1232!--                Update the NetCDF yz cross section time axis
1233                   IF ( myid == 0  .OR.  netcdf_data_format > 2 )  THEN
1234
1235                      IF ( simulated_time /= do2d_yz_last_time(av) )  THEN
1236                         do2d_yz_time_count(av) = do2d_yz_time_count(av) + 1
1237                         do2d_yz_last_time(av)  = simulated_time
1238                         IF ( ( .NOT. data_output_2d_on_each_pe  .AND.        &
1239                              netcdf_output )  .OR.  netcdf_data_format > 2 ) &
1240                         THEN
1241#if defined( __netcdf )
1242                            nc_stat = NF90_PUT_VAR( id_set_yz(av),             &
1243                                                    id_var_time_yz(av),        &
1244                                             (/ time_since_reference_point /), &
1245                                         start = (/ do2d_yz_time_count(av) /), &
1246                                                    count = (/ 1 /) )
1247                            CALL handle_netcdf_error( 'data_output_2d', 59 )
1248#endif
1249                         ENDIF
1250                      ENDIF
1251
1252                   ENDIF
1253!
1254!--                If required, carry out averaging along x
1255                   IF ( section(is,s) == -1 )  THEN
1256
1257                      ALLOCATE( local_2d_l(nysg:nyng,nzb:nzt+1) )
1258                      local_2d_l = 0.0
1259                      ngp = ( nyng-nysg+1 ) * ( nzt-nzb+2 )
1260!
1261!--                   First local averaging on the PE
1262                      DO  k = nzb, nzt+1
1263                         DO  j = nysg, nyng
1264                            DO  i = nxl, nxr
1265                               local_2d_l(j,k) = local_2d_l(j,k) + &
1266                                                 local_pf(i,j,k)
1267                            ENDDO
1268                         ENDDO
1269                      ENDDO
1270#if defined( __parallel )
1271!
1272!--                   Now do the averaging over all PEs along x
1273                      IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
1274                      CALL MPI_ALLREDUCE( local_2d_l(nysg,nzb),              &
1275                                          local_2d(nysg,nzb), ngp, MPI_REAL, &
1276                                          MPI_SUM, comm1dx, ierr )
1277#else
1278                      local_2d = local_2d_l
1279#endif
1280                      local_2d = local_2d / ( nx + 1.0 )
1281
1282                      DEALLOCATE( local_2d_l )
1283
1284                   ELSE
1285!
1286!--                   Just store the respective section on the local array
1287!--                   (but only if it is available on this PE!)
1288                      IF ( section(is,s) >= nxl  .AND.  section(is,s) <= nxr ) &
1289                      THEN
1290                         local_2d = local_pf(section(is,s),:,nzb:nzt+1)
1291                      ENDIF
1292
1293                   ENDIF
1294
1295#if defined( __parallel )
1296                   IF ( netcdf_output  .AND.  netcdf_data_format > 2 )  THEN
1297!
1298!--                   ATTENTION: The following lines are a workaround, because
1299!--                              independet output does not work with the
1300!--                              current NetCDF4 installation. Therefore, data
1301!--                              are transferred from PEs having the cross
1302!--                              sections to other PEs along y having no cross
1303!--                              section data. Some of these data are the
1304!--                              output.
1305!--                   BEGIN WORKAROUND---------------------------------------
1306                      IF ( npex /= 1  .AND.  section(is,s) /= -1)  THEN
1307                         ALLOCATE( local_2d_l(nysg:nyng,nzb:nzt+1) )
1308                         local_2d_l = 0.0
1309                         IF ( section(is,s) >= nxl .AND. section(is,s) <= nxr )&
1310                         THEN
1311                            local_2d_l = local_2d
1312                         ENDIF
1313#if defined( __parallel )
1314!
1315!--                      Distribute data over all PEs along x
1316                         ngp = ( nyng-nysg+1 ) * ( nzt-nzb + 2 )
1317                         IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr )
1318                         CALL MPI_ALLREDUCE( local_2d_l(nysg,nzb),            &
1319                                             local_2d(nysg,nzb), ngp,         &
1320                                             MPI_REAL, MPI_SUM, comm1dx, ierr )
1321#else
1322                         local_2d = local_2d_l
1323#endif
1324                         DEALLOCATE( local_2d_l )
1325                      ENDIF
1326!--                   END WORKAROUND-----------------------------------------
1327
1328!
1329!--                   Output in NetCDF4/HDF5 format.
1330!--                   Output only on those PEs where the respective cross
1331!--                   sections reside. Cross sections averaged along x are
1332!--                   output on the respective first PE along x (myidx=0).
1333                      IF ( ( section(is,s) >= nxl  .AND.  &
1334                             section(is,s) <= nxr )  .OR.  &
1335                           ( section(is,s) == -1  .AND.  myidx == 0 ) )  THEN
1336!
1337!--                      Do not output redundant ghost point data except for the
1338!--                      boundaries of the total domain.
1339#if defined( __netcdf )
1340                         IF ( nyn == ny )  THEN
1341                            nc_stat = NF90_PUT_VAR( id_set_yz(av),             &
1342                                                id_var_do2d(av,if),            &
1343                                                local_2d(nys:nyn+1,nzb:nzt+1), &
1344                                                start = (/ is, nys+1, 1,       &
1345                                                    do2d_yz_time_count(av) /), &
1346                                                count = (/ 1, nyn-nys+2,       &
1347                                                           nzt+2, 1 /) )
1348                         ELSE
1349                            nc_stat = NF90_PUT_VAR( id_set_yz(av),             &
1350                                                id_var_do2d(av,if),            &
1351                                                local_2d(nys:nyn,nzb:nzt+1),   &
1352                                                start = (/ is, nys+1, 1,       &
1353                                                    do2d_yz_time_count(av) /), &
1354                                                count = (/ 1, nyn-nys+1,       &
1355                                                           nzt+2, 1 /) )
1356                         ENDIF
1357
1358                         CALL handle_netcdf_error( 'data_output_2d', 60 )
1359
1360                      ELSE
1361!
1362!--                      Output on other PEs. Only one point is output!!
1363!--                      ATTENTION: This is a workaround (see above)!!
1364                         IF ( npex /= 1 )  THEN
1365                            nc_stat = NF90_PUT_VAR( id_set_yz(av),             &
1366                                                    id_var_do2d(av,if),        &
1367                                                    local_2d(nys:nys,nzb:nzb), &
1368                                                    start = (/ is, nys+1, 1,   &
1369                                                    do2d_yz_time_count(av) /), &
1370                                                    count = (/ 1, 1, 1, 1 /) )
1371                            CALL handle_netcdf_error( 'data_output_2d', 452 )
1372                         ENDIF
1373#endif
1374                      ENDIF
1375
1376                   ELSE
1377
1378                      IF ( data_output_2d_on_each_pe )  THEN
1379!
1380!--                      Output of partial arrays on each PE. If the cross
1381!--                      section does not reside on the PE, output special
1382!--                      index values.
1383#if defined( __netcdf )
1384                         IF ( netcdf_output  .AND.  myid == 0 )  THEN
1385                            WRITE ( 23 )  time_since_reference_point, &
1386                                          do2d_yz_time_count(av), av
1387                         ENDIF
1388#endif
1389                         DO  i = 0, io_blocks-1
1390                            IF ( i == io_group )  THEN
1391                               IF ( ( section(is,s) >= nxl  .AND.   &
1392                                      section(is,s) <= nxr )  .OR.  &
1393                                    ( section(is,s) == -1  .AND.    &
1394                                      nxl-1 == -1 ) )               &
1395                               THEN
1396                                  WRITE (23)  nysg, nyng, nzb, nzt+1
1397                                  WRITE (23)  local_2d
1398                               ELSE
1399                                  WRITE (23)  -1, -1, -1, -1
1400                               ENDIF
1401                            ENDIF
1402#if defined( __parallel )
1403                            CALL MPI_BARRIER( comm2d, ierr )
1404#endif
1405                         ENDDO
1406
1407                      ELSE
1408!
1409!--                      PE0 receives partial arrays from all processors of the
1410!--                      respective cross section and outputs them. Here a
1411!--                      barrier has to be set, because otherwise
1412!--                      "-MPI- FATAL: Remote protocol queue full" may occur.
1413                         CALL MPI_BARRIER( comm2d, ierr )
1414
1415                         ngp = ( nyng-nysg+1 ) * ( nzt-nzb+2 )
1416                         IF ( myid == 0 )  THEN
1417!
1418!--                         Local array can be relocated directly.
1419                            IF ( ( section(is,s) >= nxl  .AND.                 &
1420                                   section(is,s) <= nxr )   .OR.               &
1421                                 ( section(is,s) == -1  .AND.  nxl-1 == -1 ) ) &
1422                            THEN
1423                               total_2d(nysg:nyng,nzb:nzt+1) = local_2d
1424                            ENDIF
1425!
1426!--                         Receive data from all other PEs.
1427                            DO  n = 1, numprocs-1
1428!
1429!--                            Receive index limits first, then array.
1430!--                            Index limits are received in arbitrary order from
1431!--                            the PEs.
1432                               CALL MPI_RECV( ind(1), 4, MPI_INTEGER,     &
1433                                              MPI_ANY_SOURCE, 0, comm2d,  &
1434                                              status, ierr )
1435!
1436!--                            Not all PEs have data for YZ-cross-section.
1437                               IF ( ind(1) /= -9999 )  THEN
1438                                  sender = status(MPI_SOURCE)
1439                                  DEALLOCATE( local_2d )
1440                                  ALLOCATE( local_2d(ind(1):ind(2), &
1441                                                     ind(3):ind(4)) )
1442                                  CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, &
1443                                                 MPI_REAL, sender, 1, comm2d,  &
1444                                                 status, ierr )
1445                                  total_2d(ind(1):ind(2),ind(3):ind(4)) = &
1446                                                                        local_2d
1447                               ENDIF
1448                            ENDDO
1449!
1450!--                         Output of the total cross-section.
1451                            IF ( iso2d_output )  THEN
1452                               WRITE (23)  total_2d(0:ny+1,nzb:nzt+1)
1453                            ENDIF
1454!
1455!--                         Relocate the local array for the next loop increment
1456                            DEALLOCATE( local_2d )
1457                            ALLOCATE( local_2d(nysg:nyng,nzb:nzt+1) )
1458
1459#if defined( __netcdf )
1460                            IF ( netcdf_output )  THEN
1461                               nc_stat = NF90_PUT_VAR( id_set_yz(av),          &
1462                                                    id_var_do2d(av,if),        &
1463                                                    total_2d(0:ny+1,nzb:nzt+1),&
1464                               start = (/ is, 1, 1, do2d_yz_time_count(av) /), &
1465                                                count = (/ 1, ny+2, nz+2, 1 /) )
1466                               CALL handle_netcdf_error( 'data_output_2d', 61 )
1467                            ENDIF
1468#endif
1469
1470                         ELSE
1471!
1472!--                         If the cross section resides on the PE, send the
1473!--                         local index limits, otherwise send -9999 to PE0.
1474                            IF ( ( section(is,s) >= nxl  .AND.                 &
1475                                   section(is,s) <= nxr )  .OR.                &
1476                                 ( section(is,s) == -1  .AND.  nxl-1 == -1 ) ) &
1477                            THEN
1478                               ind(1) = nysg; ind(2) = nyng
1479                               ind(3) = nzb;   ind(4) = nzt+1
1480                            ELSE
1481                               ind(1) = -9999; ind(2) = -9999
1482                               ind(3) = -9999; ind(4) = -9999
1483                            ENDIF
1484                            CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, &
1485                                           comm2d, ierr )
1486!
1487!--                         If applicable, send data to PE0.
1488                            IF ( ind(1) /= -9999 )  THEN
1489                               CALL MPI_SEND( local_2d(nysg,nzb), ngp, &
1490                                              MPI_REAL, 0, 1, comm2d, ierr )
1491                            ENDIF
1492                         ENDIF
1493!
1494!--                      A barrier has to be set, because otherwise some PEs may
1495!--                      proceed too fast so that PE0 may receive wrong data on
1496!--                      tag 0
1497                         CALL MPI_BARRIER( comm2d, ierr )
1498                      ENDIF
1499
1500                   ENDIF
1501#else
1502                   IF ( iso2d_output )  THEN
1503                      WRITE (23)  local_2d(nys:nyn+1,nzb:nzt+1)
1504                   ENDIF
1505#if defined( __netcdf )
1506                   IF ( netcdf_output )  THEN
1507                      nc_stat = NF90_PUT_VAR( id_set_yz(av),                   &
1508                                              id_var_do2d(av,if),              &
1509                                              local_2d(nys:nyn+1,nzb:nzt+1),   &
1510                               start = (/ is, 1, 1, do2d_xz_time_count(av) /), &
1511                                              count = (/ 1, ny+2, nz+2, 1 /) )
1512                      CALL handle_netcdf_error( 'data_output_2d', 452 )
1513                   ENDIF
1514#endif
1515#endif
1516                   do2d_yz_n = do2d_yz_n + 1
1517!
1518!--                Write LOCAL-parameter set for ISO2D.
1519                   IF ( myid == 0  .AND.  iso2d_output )  THEN
1520                      IF ( section(is,s) /= -1 )  THEN
1521                         WRITE ( section_chr, '(''x = '',F8.2,'' m  (GP '',I3, &
1522                                               &'')'')'                        &
1523                               )  section(is,s)*dx, section(is,s)
1524                      ELSE
1525                         section_chr = 'averaged along x'
1526                      ENDIF
1527                      IF ( av == 0 )  THEN
1528                         rtext = TRIM( do2d(av,if) ) // '  t = ' //    &
1529                                 TRIM( simulated_time_chr ) // '  ' // &
1530                                 TRIM( section_chr )
1531                      ELSE
1532                         rtext = TRIM( do2d(av,if) ) // '  averaged t = ' // &
1533                                 TRIM( simulated_time_chr ) // '  ' //       &
1534                                 TRIM( section_chr )
1535                      ENDIF
1536                      WRITE (29,LOCAL)
1537                   ENDIF
1538
1539             END SELECT
1540
1541             is = is + 1
1542          ENDDO loop1
1543
1544       ENDIF
1545
1546       if = if + 1
1547       l = MAX( 2, LEN_TRIM( do2d(av,if) ) )
1548       do2d_mode = do2d(av,if)(l-1:l)
1549
1550    ENDDO
1551
1552!
1553!-- Deallocate temporary arrays.
1554    IF ( ALLOCATED( level_z ) )  DEALLOCATE( level_z )
1555    DEALLOCATE( local_pf, local_2d )
1556#if defined( __parallel )
1557    IF ( .NOT.  data_output_2d_on_each_pe  .AND.  myid == 0 )  THEN
1558       DEALLOCATE( total_2d )
1559    ENDIF
1560#endif
1561
1562!
1563!-- Close plot output file.
1564    file_id = 20 + s
1565
1566    IF ( data_output_2d_on_each_pe )  THEN
1567       DO  i = 0, io_blocks-1
1568          IF ( i == io_group )  THEN
1569             CALL close_file( file_id )
1570          ENDIF
1571#if defined( __parallel )
1572          CALL MPI_BARRIER( comm2d, ierr )
1573#endif
1574       ENDDO
1575    ELSE
1576       IF ( myid == 0 )  CALL close_file( file_id )
1577    ENDIF
1578
1579
1580    CALL cpu_log (log_point(3),'data_output_2d','stop','nobarrier')
1581
1582 END SUBROUTINE data_output_2d
Note: See TracBrowser for help on using the repository browser.