source: palm/trunk/SOURCE/data_output_profiles.f90 @ 285

Last change on this file since 285 was 274, checked in by heinze, 15 years ago

Indentation of the message calls corrected

  • Property svn:keywords set to Id
File size: 24.9 KB
Line 
1 SUBROUTINE data_output_profiles
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6! Output of NetCDF messages with aid of message handling routine.
7! Output of messages replaced by message handling routine.
8!
9!
10! Former revisions:
11! -----------------
12! $Id: data_output_profiles.f90 274 2009-03-26 15:11:21Z raasch $
13!
14! 197 2008-09-16 15:29:03Z raasch
15! Time coordinate t=0 stored on netcdf-file only if an output is required for
16! this time for at least one of the profiles
17!
18! February 2007
19! RCS Log replace by Id keyword, revision history cleaned up
20!
21! 87 2007-05-22 15:46:47Z raasch
22! var_hom renamed pr_palm
23!
24! Revision 1.18  2006/08/16 14:27:04  raasch
25! PRINT* statements for testing removed
26!
27! Revision 1.1  1997/09/12 06:28:48  raasch
28! Initial revision
29!
30!
31! Description:
32! ------------
33! Plot output of 1D-profiles for PROFIL
34!------------------------------------------------------------------------------!
35
36    USE control_parameters
37    USE cpulog
38    USE indices
39    USE interfaces
40    USE netcdf_control
41    USE pegrid
42    USE profil_parameter
43    USE statistics
44
45    IMPLICIT NONE
46
47
48    INTEGER ::  i, id, ilc, ils, j, k, sr
49    LOGICAL ::  output_for_t0
50    REAL    ::  uxma, uxmi
51
52
53!
54!-- If required, compute statistics
55    IF ( .NOT. flow_statistics_called )  CALL flow_statistics
56
57!
58!-- Flow_statistics has its own CPU time measurement
59    CALL cpu_log( log_point(15), 'data_output_profiles', 'start' )
60
61!
62!-- If required, compute temporal average
63    IF ( averaging_interval_pr == 0.0 )  THEN
64       hom_sum(:,:,:) = hom(:,1,:,:)
65    ELSE
66       IF ( average_count_pr > 0 )  THEN
67          hom_sum = hom_sum / REAL( average_count_pr )
68       ELSE
69!
70!--       This case may happen if dt_dopr is changed in the d3par-list of
71!--       a restart run
72          RETURN
73       ENDIF
74    ENDIF
75
76   
77    IF ( myid == 0 )  THEN
78
79!
80!--    Plot-output for each (sub-)region
81
82!
83!--    Open file for profile output in NetCDF format
84       IF ( netcdf_output )  THEN
85          CALL check_open( 104 )
86       ENDIF
87
88!
89!--    Open PROFIL-output files for each (sub-)region
90       IF ( profil_output )  THEN
91          DO  sr = 0, statistic_regions
92             CALL check_open( 40 + sr )
93          ENDDO
94       ENDIF
95
96!
97!--    Increment the counter for number of output times
98       dopr_time_count = dopr_time_count + 1
99
100!
101!--    Re-set to zero the counter for the number of profiles already written
102!--    at the current output time into the respective crosses
103       cross_pnc_local = 0
104
105!
106!--    Output of initial profiles
107       IF ( dopr_time_count == 1 )  THEN
108
109          IF ( netcdf_output )  THEN
110#if defined( __netcdf )
111!
112!--          Store initial time (t=0) to time axis, but only if an output
113!--          is required for at least one of the profiles
114             output_for_t0 = .FALSE.
115             DO  i = 1, dopr_n
116                IF ( dopr_initial_index(i) /= 0 )  THEN
117                   nc_stat = NF90_PUT_VAR( id_set_pr, id_var_time_pr,  &
118                                           (/ 0.0 /), start = (/ 1 /), &
119                                           count = (/ 1 /) )
120                   CALL handle_netcdf_error( 'data_output_profiles', 329 )
121                   output_for_t0 = .TRUE.
122                   EXIT
123                ENDIF
124             ENDDO
125
126!
127!--          Store normalization factors
128             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(1), &  ! wpt0
129                                  (/ hom_sum(nzb,18,normalizing_region) /), &
130                                     start = (/ 1 /), count = (/ 1 /) )
131             CALL handle_netcdf_error( 'data_output_profiles', 330 )
132
133             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(2), &  ! ws2
134                        (/ hom_sum(nzb+8,pr_palm,normalizing_region)**2 /), &
135                                     start = (/ 1 /), count = (/ 1 /) )
136             CALL handle_netcdf_error( 'data_output_profiles', 331 )
137             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(3), &  ! tsw2
138                        (/ hom_sum(nzb+3,pr_palm,normalizing_region)**2 /), &
139                                     start = (/ 1 /), count = (/ 1 /) )
140             CALL handle_netcdf_error( 'data_output_profiles', 332 )
141             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(4), &  ! ws3
142                        (/ hom_sum(nzb+8,pr_palm,normalizing_region)**3 /), &
143                                     start = (/ 1 /), count = (/ 1 /) )
144             CALL handle_netcdf_error( 'data_output_profiles', 333 )
145
146             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(5), &  ! ws2tsw
147                        (/ hom_sum(nzb+8,pr_palm,normalizing_region)**3 *   &
148                           hom_sum(nzb+3,pr_palm,normalizing_region)    /), &
149                                     start = (/ 1 /), count = (/ 1 /) )
150             CALL handle_netcdf_error( 'data_output_profiles', 334 )
151
152             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(6), &  ! wstsw2
153                        (/ hom_sum(nzb+8,pr_palm,normalizing_region) *      &
154                           hom_sum(nzb+3,pr_palm,normalizing_region)**2 /), &
155                                     start = (/ 1 /), count = (/ 1 /) )
156             CALL handle_netcdf_error( 'data_output_profiles', 335 )
157
158             nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(7), &  ! z_i
159                           (/ hom_sum(nzb+6,pr_palm,normalizing_region) /), &
160                                     start = (/ 1 /), count = (/ 1 /) )
161             CALL handle_netcdf_error( 'data_output_profiles', 336 )
162#endif
163          ENDIF
164!
165!--       Loop over all 1D variables
166          DO  i = 1, dopr_n
167
168             IF ( dopr_initial_index(i) /= 0 )  THEN
169
170!
171!--             Output for the individual (sub-)regions
172                DO  sr = 0, statistic_regions
173
174                   IF ( profil_output )  THEN
175                      id = 40 + sr
176!
177!--                   Write Label-Header
178                      WRITE ( id, 100 )  TRIM( data_output_pr(i) ), '(t=0)'
179!
180!--                   Write total profile
181                      DO  k = nzb, nzt+1
182                         WRITE ( id, 101 )  hom(k,2,dopr_initial_index(i),sr), &
183                                            hom(k,1,dopr_initial_index(i),sr)
184                      ENDDO
185!
186!--                   Write separation label
187                      WRITE ( id, 102 )
188                   ENDIF
189
190                   IF ( netcdf_output )  THEN
191#if defined( __netcdf )
192!
193!--                   Write data to netcdf file
194                      nc_stat = NF90_PUT_VAR( id_set_pr, id_var_dopr(i,sr),    &
195                                    hom(nzb:nzt+1,1,dopr_initial_index(i),sr), &
196                                              start = (/ 1, 1 /),              &
197                                              count = (/ nzt-nzb+2, 1 /) )
198                      CALL handle_netcdf_error( 'data_output_profiles', 337 )
199#endif
200                   ENDIF
201
202                ENDDO
203
204                IF ( profil_output )  THEN
205!
206!--                Determine indices for later NAMELIST-output (s. below)
207                   profile_number = profile_number + 1
208                   j = dopr_crossindex(i)
209                   IF ( j /= 0 )  THEN
210                      cross_profile_number_count(j) = &
211                                               cross_profile_number_count(j) + 1
212                      k = cross_profile_number_count(j)
213                      cross_profile_numbers(k,j) = profile_number
214!
215!--                   Initial profiles are always drawn as solid lines in
216!--                   anti-background colour.
217                      cross_linecolors(k,j) = 1
218                      cross_linestyles(k,j) = 0
219!
220!--                   If required, extend x-value range of the respective
221!--                   cross, provided it has not been specified in &
222!--                   check_parameters. Determination over all (sub-)regions.
223                      IF ( cross_uxmin(j) == 0.0  .AND. &
224                           cross_uxmax(j) == 0.0 )  THEN
225
226                         DO  sr = 0, statistic_regions
227
228                            uxmi = &
229                            MINVAL( hom(:nz_do1d,1,dopr_initial_index(i),sr) )
230
231                            uxma = &
232                            MAXVAL( hom(:nz_do1d,1,dopr_initial_index(i),sr) )
233!
234!--                         When the value range of the first line in the
235!--                         corresponding cross is determined, its value range
236!--                         is simply adopted.
237                            IF ( cross_uxmin_computed(j) > &
238                                 cross_uxmax_computed(j) )  THEN
239                               cross_uxmin_computed(j) = uxmi
240                               cross_uxmax_computed(j) = uxma
241                            ELSE
242                               cross_uxmin_computed(j) = &
243                                            MIN( cross_uxmin_computed(j), uxmi )
244                               cross_uxmax_computed(j) = &
245                                            MAX( cross_uxmax_computed(j), uxma )
246                            ENDIF
247
248                         ENDDO
249
250                      ENDIF
251!
252!--                   If required, determine and note normalizing factors
253                      SELECT CASE ( cross_normalized_x(j) )
254
255                         CASE ( 'ts2' )
256                            cross_normx_factor(k,j) = &
257                             ( hom_sum(nzb+3,pr_palm,normalizing_region) )**2
258                         CASE ( 'wpt0' )
259                            cross_normx_factor(k,j) = &
260                             hom_sum(nzb,18,normalizing_region)
261                         CASE ( 'wsts2' )
262                            cross_normx_factor(k,j) = &
263                             hom_sum(nzb+8,pr_palm,normalizing_region)  &
264                           * ( hom_sum(nzb+3,pr_palm,normalizing_region) )**2
265                         CASE ( 'ws2' )
266                            cross_normx_factor(k,j) = &
267                             ( hom_sum(nzb+8,pr_palm,normalizing_region) )**2
268                         CASE ( 'ws2ts' )
269                            cross_normx_factor(k,j) = &
270                           ( hom_sum(nzb+8,pr_palm,normalizing_region) )**2 &
271                           * hom_sum(nzb+3,pr_palm,normalizing_region)
272                         CASE ( 'ws3' )
273                            cross_normx_factor(k,j) = &
274                             ( hom_sum(nzb+8,pr_palm,normalizing_region) )**3
275
276                      END SELECT
277
278                      SELECT CASE ( cross_normalized_y(j) )
279
280                         CASE ( 'z_i' )
281                            cross_normy_factor(k,j) = &
282                                    hom_sum(nzb+6,pr_palm,normalizing_region)
283
284                      END SELECT
285
286!
287!--                   Check the normalizing factors for zeros and deactivate
288!--                   the normalization, if required.
289                      IF ( cross_normx_factor(k,j) == 0.0  .OR. &
290                           cross_normy_factor(k,j) == 0.0 )  THEN
291                         WRITE( message_string, * ) 'data_output_profiles: ',  &
292                              'normalizing cross ',j, ' is not possible ',     &
293                              'since one of the & normalizing factors ',       &
294                              'is zero! & cross_normx_factor(',k,',',j,') = ', &
295                                                      cross_normx_factor(k,j), &
296                              ' & cross_normy_factor(',k,',',j,') = ',         &
297                                                      cross_normy_factor(k,j)
298                         CALL message( 'data_output_profiles', 'PA0185',&
299                                                                0, 1, 0, 6, 0 )
300                         cross_normx_factor(k,j) = 1.0
301                         cross_normy_factor(k,j) = 1.0
302                         cross_normalized_x(j) = ' '
303                         cross_normalized_y(j) = ' '
304                      ENDIF
305
306!
307!--                   If required, extend normalized x-value range of the
308!--                   respective cross, provided it has not been specified in
309!--                   check_parameters. Determination over all (sub-)regions.
310                      IF ( cross_uxmin_normalized(j) == 0.0  .AND. &
311                           cross_uxmax_normalized(j) == 0.0 )  THEN
312
313                         DO  sr = 0, statistic_regions
314
315                            uxmi = MINVAL( hom(:nz_do1d,1,             &
316                                           dopr_initial_index(i),sr) ) / &
317                                   cross_normx_factor(k,j)
318                            uxma = MAXVAL( hom(:nz_do1d,1,             &
319                                           dopr_initial_index(i),sr) ) / &
320                                   cross_normx_factor(k,j)
321!
322!--                         When the value range of the first line in the
323!--                         corresponding cross is determined, its value range
324!--                         is simply adopted.
325                            IF ( cross_uxmin_normalized_computed(j) > &
326                                 cross_uxmax_normalized_computed(j) )  THEN
327                               cross_uxmin_normalized_computed(j) = uxmi
328                               cross_uxmax_normalized_computed(j) = uxma
329                            ELSE
330                               cross_uxmin_normalized_computed(j) = &
331                                 MIN( cross_uxmin_normalized_computed(j), uxmi )
332                               cross_uxmax_normalized_computed(j) = &
333                                 MAX( cross_uxmax_normalized_computed(j), uxma )
334                            ENDIF
335
336                         ENDDO
337
338                      ENDIF
339
340                   ENDIF   ! Index determination
341
342                ENDIF   ! profil output
343
344             ENDIF   ! Initial profile available
345
346          ENDDO   ! Loop over dopr_n for initial profiles
347
348          IF ( netcdf_output  .AND.  output_for_t0 )  THEN
349             dopr_time_count = dopr_time_count + 1
350          ENDIF
351
352       ENDIF   ! Initial profiles
353
354       IF ( netcdf_output )  THEN
355#if defined( __netcdf )
356!
357!--       Store time to time axis         
358          nc_stat = NF90_PUT_VAR( id_set_pr, id_var_time_pr,     &
359                                  (/ simulated_time /),          &
360                                  start = (/ dopr_time_count /), &
361                                  count = (/ 1 /) )
362          CALL handle_netcdf_error( 'data_output_profiles', 338 )
363
364!
365!--       Store normalization factors
366          nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(1), &  ! wpt0
367                                  (/ hom_sum(nzb,18,normalizing_region) /), &
368                                  start = (/ dopr_time_count /),               &
369                                  count = (/ 1 /) )
370          CALL handle_netcdf_error( 'data_output_profiles', 339 )
371
372          nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(2), &  ! ws2
373                        (/ hom_sum(nzb+8,pr_palm,normalizing_region)**2 /), &
374                                  start = (/ dopr_time_count /),               &
375                                  count = (/ 1 /) )
376          CALL handle_netcdf_error( 'data_output_profiles', 340 )
377
378          nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(3), &  ! tsw2
379                        (/ hom_sum(nzb+3,pr_palm,normalizing_region)**2 /), &
380                                  start = (/ dopr_time_count /),               &
381                                  count = (/ 1 /) )
382          CALL handle_netcdf_error( 'data_output_profiles', 341 )
383
384          nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(4), &  ! ws3
385                        (/ hom_sum(nzb+8,pr_palm,normalizing_region)**3 /), &
386                                  start = (/ dopr_time_count /),               &
387                                  count = (/ 1 /) )
388          CALL handle_netcdf_error( 'data_output_profiles', 342 )
389
390          nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(5), &  ! ws2tsw
391                        (/ hom_sum(nzb+8,pr_palm,normalizing_region)**3 *   &
392                           hom_sum(nzb+3,pr_palm,normalizing_region)    /), &
393                                  start = (/ dopr_time_count /),               &
394                                  count = (/ 1 /) )
395          CALL handle_netcdf_error( 'data_output_profiles', 343 )
396         
397          nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(6), &  ! wstsw2
398                        (/ hom_sum(nzb+8,pr_palm,normalizing_region) *      &
399                           hom_sum(nzb+3,pr_palm,normalizing_region)**2 /), &
400                                  start = (/ dopr_time_count /),               &
401                                  count = (/ 1 /) )
402          CALL handle_netcdf_error( 'data_output_profiles', 344 )
403
404          nc_stat = NF90_PUT_VAR( id_set_pr, id_var_norm_dopr(7), &  ! z_i
405                           (/ hom_sum(nzb+6,pr_palm,normalizing_region) /), &
406                                  start = (/ dopr_time_count /),               &
407                                  count = (/ 1 /) )
408          CALL handle_netcdf_error( 'data_output_profiles', 345 )
409#endif
410       ENDIF
411
412!
413!--    Output of the individual (non-initial) profiles
414       DO  i = 1, dopr_n
415
416!
417!--       Output for the individual (sub-)domains
418          DO  sr = 0, statistic_regions
419
420             IF ( profil_output )  THEN
421                id = 40 + sr
422!
423!--             Write Label-Header
424                WRITE ( id, 100 )  TRIM( dopr_label(i) ), simulated_time_chr
425!
426!--             Output of total profile
427                DO  k = nzb, nzt+1
428                   WRITE ( id, 101 )  hom(k,2,dopr_index(i),sr), &
429                                      hom_sum(k,dopr_index(i),sr)
430                ENDDO
431!
432!--             Write separation label
433                WRITE ( id, 102 )
434             ENDIF
435
436             IF ( netcdf_output )  THEN
437#if defined( __netcdf )
438!
439!--             Write data to netcdf file
440                nc_stat = NF90_PUT_VAR( id_set_pr, id_var_dopr(i,sr),          &
441                                        hom_sum(nzb:nzt+1,dopr_index(i),sr),&
442                                        start = (/ 1, dopr_time_count /),      &
443                                        count = (/ nzt-nzb+2, 1 /) )
444                CALL handle_netcdf_error( 'data_output_profiles', 346 )
445#endif
446             ENDIF
447
448          ENDDO
449
450          IF ( profil_output )  THEN
451!
452!--          Determine profile number on file and note the data for later
453!--          NAMELIST output, if the respective profile is to be drawn by
454!--          PROFIL (if it shall not be drawn, the variable dopr_crossindex has
455!--          the value 0, otherwise the number of the coordinate cross)
456             profile_number = profile_number + 1
457             j = dopr_crossindex(i)
458
459             IF ( j /= 0 )  THEN
460                cross_profile_number_count(j) = cross_profile_number_count(j) +1
461                k = cross_profile_number_count(j)
462                cross_pnc_local(j)            = cross_pnc_local(j)            +1
463                cross_profile_numbers(k,j) = profile_number
464                ilc = MOD( dopr_time_count, 10 )
465                IF ( ilc == 0 )  ilc = 10
466                cross_linecolors(k,j) = linecolors(ilc)
467                ils = MOD( cross_pnc_local(j), 11 )
468                IF ( ils == 0 )  ils = 11
469                cross_linestyles(k,j) = linestyles(ils)
470!
471!--             If required, extend x-value range of the respective coordinate
472!--             cross, provided it has not been specified in check_parameters.
473!--             Determination over all (sub-)regions.
474                IF ( cross_uxmin(j) == 0.0  .AND.  cross_uxmax(j) == 0.0 )  THEN
475
476                   DO  sr = 0, statistic_regions
477
478                      uxmi = MINVAL( hom_sum(:nz_do1d,dopr_index(i),sr) )
479                      uxma = MAXVAL( hom_sum(:nz_do1d,dopr_index(i),sr) )
480!
481!--                   When the value range of the first line in the
482!--                   corresponding cross is determined, its value range is
483!--                   simply adopted.
484                      IF ( cross_uxmin_computed(j) > cross_uxmax_computed(j) ) &
485                      THEN
486                         cross_uxmin_computed(j) = uxmi
487                         cross_uxmax_computed(j) = uxma
488                      ELSE
489                         cross_uxmin_computed(j) = &
490                                           MIN( cross_uxmin_computed(j), uxmi )
491                         cross_uxmax_computed(j) = &
492                                           MAX( cross_uxmax_computed(j), uxma )
493                      ENDIF
494
495                   ENDDO
496
497                ENDIF
498!
499!--             If required, store the normalizing factors
500                SELECT CASE ( cross_normalized_x(j) )
501
502                   CASE ( 'tsw2' )
503                      cross_normx_factor(k,j) = &
504                            ( hom_sum(nzb+11,pr_palm,normalizing_region) )**2
505                   CASE ( 'wpt0' )
506                      cross_normx_factor(k,j) = &
507                              hom_sum(nzb,18,normalizing_region)
508                   CASE ( 'wstsw2' )
509                      cross_normx_factor(k,j) = &
510                              hom_sum(nzb+8,pr_palm,normalizing_region)  &
511                          * ( hom_sum(nzb+11,pr_palm,normalizing_region) )**2
512                   CASE ( 'ws2' )
513                      cross_normx_factor(k,j) = &
514                            ( hom_sum(nzb+8,pr_palm,normalizing_region) )**2
515                   CASE ( 'ws2tsw' )
516                      cross_normx_factor(k,j) = &
517                            ( hom_sum(nzb+8,pr_palm,normalizing_region) )**2&
518                            * hom_sum(nzb+11,pr_palm,normalizing_region)
519                   CASE ( 'ws3' )
520                      cross_normx_factor(k,j) = &
521                            ( hom_sum(nzb+8,pr_palm,normalizing_region) )**3
522
523                END SELECT
524                SELECT CASE ( cross_normalized_y(j) )
525
526                   CASE ( 'z_i' )
527                      cross_normy_factor(k,j) = &
528                                   hom_sum(nzb+6,pr_palm,normalizing_region)
529
530                END SELECT
531
532!
533!--             Check the normalizing factors for zeros and deactivate
534!--             the normalization, if required.
535                IF ( cross_normx_factor(k,j) == 0.0  .OR. &
536                     cross_normy_factor(k,j) == 0.0 )  THEN
537                   WRITE( message_string, * ) 'data_output_profiles: ',  &
538                              'normalizing cross ',j, ' is not possible ',     &
539                              'since one of the & normalizing factors ',       &
540                              'is zero! & cross_normx_factor(',k,',',j,') = ', &
541                                                      cross_normx_factor(k,j), &
542                              ' & cross_normy_factor(',k,',',j,') = ',         &
543                                                      cross_normy_factor(k,j)
544                         CALL message( 'data_output_profiles', 'PA0185',&
545                                                                0, 1, 0, 6, 0 )
546                    cross_normx_factor(k,j) = 1.0
547                    cross_normy_factor(k,j) = 1.0
548                    cross_normalized_x(j) = ' '
549                    cross_normalized_y(j) = ' '
550                ENDIF
551
552!
553!--             If required, extend normalized x-value range of the respective 
554!--             cross, provided it has not been specified in check_parameters.
555!--             Determination over all (sub-)regions.
556                IF ( cross_uxmin_normalized(j) == 0.0  .AND. &
557                     cross_uxmax_normalized(j) == 0.0 )  THEN
558
559                   DO  sr = 0, statistic_regions
560
561                      uxmi = MINVAL( hom(:nz_do1d,1,dopr_index(i),sr) ) / &
562                             cross_normx_factor(k,j)
563                      uxma = MAXVAL( hom(:nz_do1d,1,dopr_index(i),sr) ) / &
564                             cross_normx_factor(k,j)
565!
566!--                   When the value range of the first line in the
567!--                   corresponding cross is determined, its value range is
568!--                   simply adopted.
569                      IF ( cross_uxmin_normalized_computed(j) > &
570                           cross_uxmax_normalized_computed(j) )  THEN
571                         cross_uxmin_normalized_computed(j) = uxmi
572                         cross_uxmax_normalized_computed(j) = uxma
573                      ELSE
574                         cross_uxmin_normalized_computed(j) = &
575                                MIN( cross_uxmin_normalized_computed(j), uxmi )
576                         cross_uxmax_normalized_computed(j) = &
577                                MAX( cross_uxmax_normalized_computed(j), uxma )
578                      ENDIF
579
580                   ENDDO
581
582                ENDIF
583
584             ENDIF   ! Index determination
585
586          ENDIF   ! profil output
587
588       ENDDO   ! Loop over dopr_n
589
590    ENDIF  ! Output on PE0
591
592!
593!-- If averaging has been done above, the summation counter must be re-set.
594    IF ( averaging_interval_pr /= 0.0 )  THEN
595       average_count_pr = 0
596    ENDIF
597
598    CALL cpu_log( log_point(15), 'data_output_profiles','stop', 'nobarrier' )
599
600!
601!-- Formats
602100 FORMAT ('#1 ',A,1X,A)
603101 FORMAT (E15.7,1X,E15.7)
604102 FORMAT ('NEXT')
605
606 END SUBROUTINE data_output_profiles
Note: See TracBrowser for help on using the repository browser.