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

Last change on this file since 343 was 343, checked in by maronga, 15 years ago

adjustments for lcxt4 and ibmy, allow user 2d xy cross section output at z=nzb+1

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