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

Last change on this file since 785 was 772, checked in by heinze, 12 years ago

last commit documented

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