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

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

adapted for machine lck

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