source: palm/tags/release-3.2/SOURCE/data_output_profiles.f90 @ 1320

Last change on this file since 1320 was 4, checked in by raasch, 17 years ago

Id keyword set as property for all *.f90 files

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