source: palm/trunk/SOURCE/data_output_spectra.f90 @ 1353

Last change on this file since 1353 was 1353, checked in by heinze, 10 years ago

REAL constants provided with KIND-attribute

  • Property svn:keywords set to Id
File size: 21.0 KB
Line 
1 SUBROUTINE data_output_spectra
2
3!--------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2014 Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
22! REAL constants provided with KIND-attribute
23!
24! Former revisions:
25! -----------------
26! $Id: data_output_spectra.f90 1353 2014-04-08 15:21:23Z heinze $
27!
28! 1327 2014-03-21 11:00:16Z raasch
29! -netcdf output queries
30!
31! 1324 2014-03-21 09:13:16Z suehring
32! Bugfix: module statistics and module spectrum added, missing variables in ONLY
33! arguments added
34!
35! 1322 2014-03-20 16:38:49Z raasch
36! REAL functions provided with KIND-attribute
37!
38! 1320 2014-03-20 08:40:49Z raasch
39! ONLY-attribute added to USE-statements,
40! kind-parameters added to all INTEGER and REAL declaration statements,
41! kinds are defined in new module kinds,
42! revision history before 2012 removed,
43! comment fields (!:) to be used for variable explanations added to
44! all variable declaration statements
45!
46! 1318 2014-03-17 13:35:16Z raasch
47! module interfaces removed
48!
49! 1036 2012-10-22 13:43:42Z raasch
50! code put under GPL (PALM 3.9)
51!
52! 964 2012-07-26 09:14:24Z raasch
53! code for profil-output removed
54!
55! Revision 1.1  2001/01/05 15:14:20  raasch
56! Initial revision
57!
58!
59! Description:
60! ------------
61! Writing spectra data on file, using a special format which allows
62! plotting of these data with PROFIL-graphic-software
63!------------------------------------------------------------------------------!
64#if defined( __spectra )
65
66    USE control_parameters,                                                    &
67        ONLY:  average_count_sp, averaging_interval_sp, dosp_time_count,       &
68               message_string, run_description_header,                         &
69               time_since_reference_point
70
71    USE cpulog,                                                                &
72        ONLY:  cpu_log, log_point
73
74    USE kinds
75
76    USE netcdf_control
77
78    USE pegrid
79
80    USE spectrum,                                                              &
81        ONLY:  data_output_sp, spectra_direction
82
83    USE statistics,                                                            &
84        ONLY:  spectrum_x, spectrum_y
85
86
87    IMPLICIT NONE
88
89    INTEGER(iwp) ::  cranz_x !:
90    INTEGER(iwp) ::  cranz_y !:
91    INTEGER(iwp) ::  m       !:
92    INTEGER(iwp) ::  pr      !:
93   
94    LOGICAL      ::  frame_x !:
95    LOGICAL      ::  frame_y !:
96
97    CALL cpu_log( log_point(31), 'data_output_spectra', 'start' )
98
99!
100!-- Output is only performed on PE0
101    IF ( myid == 0 )  THEN
102
103!
104!--    Open file for spectra output in NetCDF format
105       CALL check_open( 107 )
106
107!
108!--    Increment the counter for number of output times
109       dosp_time_count = dosp_time_count + 1
110
111#if defined( __netcdf )
112!
113!--    Update the spectra time axis
114       nc_stat = NF90_PUT_VAR( id_set_sp, id_var_time_sp,        &
115                               (/ time_since_reference_point /), &
116                               start = (/ dosp_time_count /), count = (/ 1 /) )
117       CALL handle_netcdf_error( 'data_output_spectra', 47 )
118#endif
119
120!
121!--    If necessary, calculate time average and reset average counter
122       IF ( average_count_sp == 0 )  THEN
123           message_string = 'no spectra data available'
124           CALL message( 'data_output_spectra', 'PA0186', 0, 0, 0, 6, 0 )
125       ENDIF
126       IF ( average_count_sp /= 1 )  THEN
127          spectrum_x = spectrum_x / REAL( average_count_sp, KIND=wp )
128          spectrum_y = spectrum_y / REAL( average_count_sp, KIND=wp )
129          average_count_sp = 0
130       ENDIF
131
132!
133!--    Loop over all spectra defined by the user
134       m = 1
135       DO WHILE ( data_output_sp(m) /= ' '  .AND.  m <= 10 )
136
137          SELECT CASE ( TRIM( data_output_sp(m) ) )
138
139             CASE ( 'u' )
140                pr = 1
141
142             CASE ( 'v' )
143                pr = 2
144
145             CASE ( 'w' )
146                pr = 3
147
148             CASE ( 'pt' )
149                pr = 4
150
151             CASE ( 'q' )
152                pr = 5
153
154             CASE DEFAULT
155!
156!--             The DEFAULT case is reached either if the parameter
157!--             data_output_sp(m) contains a wrong character string or if the
158!--             user has coded a special case in the user interface. There, the
159!--             subroutine user_spectra checks which of these two conditions
160!--             applies.
161                CALL user_spectra( 'data_output', m, pr )
162
163          END SELECT
164
165!
166!--       Output of spectra in NetCDF format
167!--       Output of x-spectra
168          IF ( INDEX( spectra_direction(m), 'x' ) /= 0 ) THEN
169             CALL output_spectra_netcdf( m, 'x' )
170          ENDIF
171!
172!--       Output of y-spectra
173          IF ( INDEX( spectra_direction(m), 'y' ) /= 0 ) THEN
174             CALL output_spectra_netcdf( m, 'y' )
175          ENDIF
176
177!
178!--       Increase counter for next spectrum
179          m = m + 1
180
181       ENDDO
182
183!
184!--    Reset spectra values
185       spectrum_x = 0.0_wp; spectrum_y = 0.0_wp
186
187    ENDIF
188
189    CALL cpu_log( log_point(31), 'data_output_spectra', 'stop' )
190
191#if defined( __parallel )
192!    CALL MPI_BARRIER( comm2d, ierr )  ! really necessary
193#endif
194
195#endif
196 END SUBROUTINE data_output_spectra
197
198
199 SUBROUTINE output_spectra_netcdf( nsp, direction )
200#if defined( __netcdf )
201
202    USE constants,                                                             &
203        ONLY:  pi
204
205    USE control_parameters,                                                    &
206        ONLY:  dosp_time_count
207
208    USE grid_variables,                                                        &
209        ONLY:  dx, dy
210
211    USE indices,                                                               &
212        ONLY:  nx, ny
213
214    USE kinds
215
216    USE netcdf_control
217
218    USE spectrum,                                                              &
219        ONLY:  n_sp_x, n_sp_y
220
221    USE statistics,                                                            &
222        ONLY:  spectrum_x, spectrum_y
223
224    IMPLICIT NONE
225
226    CHARACTER (LEN=1), INTENT(IN) ::  direction     !:
227
228    INTEGER(iwp), INTENT(IN)      ::  nsp           !:
229
230    INTEGER(iwp)                  ::  i             !:
231    INTEGER(iwp)                  ::  k             !:
232
233    REAL(wp)                      ::  frequency     !:
234
235    REAL(wp), DIMENSION(nx/2)     ::  netcdf_data_x !:
236    REAL(wp), DIMENSION(ny/2)     ::  netcdf_data_y !:
237
238
239    IF ( direction == 'x' )  THEN
240
241       DO  k = 1, n_sp_x
242
243          DO  i = 1, nx/2
244             frequency = 2.0_wp * pi * i / ( dx * ( nx + 1 ) )
245             netcdf_data_x(i) = frequency * spectrum_x(i,k,nsp)
246          ENDDO
247
248          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_dospx(nsp), netcdf_data_x, &
249                                  start = (/ 1, k, dosp_time_count /), &
250                                  count = (/ nx/2, 1, 1 /) )
251          CALL handle_netcdf_error( 'data_output_spectra', 348 )
252
253       ENDDO
254
255    ENDIF
256
257    IF ( direction == 'y' )  THEN
258
259       DO  k = 1, n_sp_y
260
261          DO  i = 1, ny/2
262             frequency = 2.0_wp * pi * i / ( dy * ( ny + 1 ) )
263             netcdf_data_y(i) = frequency * spectrum_y(i,k,nsp)
264          ENDDO
265
266          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_dospy(nsp), netcdf_data_y, &
267                                  start = (/ 1, k, dosp_time_count /), &
268                                  count = (/ ny/2, 1, 1 /) )
269          CALL handle_netcdf_error( 'data_output_spectra', 349 )
270
271       ENDDO
272
273    ENDIF
274
275#endif
276 END SUBROUTINE output_spectra_netcdf
277
278
279#if defined( __spectra )
280 SUBROUTINE data_output_spectra_x( m, cranz, pr, frame_written )
281
282    USE arrays_3d,                                                             &
283        ONLY:  zu, zw
284    USE constants,                                                             &
285        ONLY:  pi
286
287    USE control_parameters,                                                    &
288        ONLY:  averaging_interval_sp, run_description_header, simulated_time_chr
289
290    USE grid_variables,                                                        &
291        ONLY:  dx
292
293    USE indices,                                                               &
294        ONLY:  nx
295
296    USE kinds
297
298    USE pegrid
299
300    USE statistics,                                                            &
301        ONLY:  spectrum_x
302
303    USE spectrum,                                                              &
304        ONLY:  comp_spectra_level, header_char, lstyles, klist_x, n_sp_x,      &
305               plot_spectra_level, utext_char, ytext_char
306
307    IMPLICIT NONE
308
309    CHARACTER (LEN=30) ::  atext !:
310   
311    INTEGER(iwp)       ::  i     !:
312    INTEGER(iwp)       ::  j     !:
313    INTEGER(iwp)       ::  k     !:
314    INTEGER(iwp)       ::  m     !:
315    INTEGER(iwp)       ::  pr    !:
316   
317    LOGICAL            ::  frame_written   !:
318   
319    REAL(wp)           ::  frequency = 0.0_wp !:
320!
321!-- Variables needed for PROFIL-namelist
322    CHARACTER (LEN=80) ::  rtext                !:
323    CHARACTER (LEN=80) ::  utext                !:
324    CHARACTER (LEN=80) ::  xtext = 'k in m>->1' !:
325    CHARACTER (LEN=80) ::  ytext                !:
326
327    INTEGER(iwp)       ::  cranz       !:
328    INTEGER(iwp)       ::  labforx = 3 !:
329    INTEGER(iwp)       ::  labfory = 3 !:
330    INTEGER(iwp)       ::  legpos  = 3 !:
331    INTEGER(iwp)       ::  timodex = 1 !:
332   
333    INTEGER(iwp), DIMENSION(1:100) ::  cucol  = 1      !:
334    INTEGER(iwp), DIMENSION(1:100) ::  klist  = 999999 !:
335    INTEGER(iwp), DIMENSION(1:100) ::  lstyle = 0      !:
336   
337    LOGICAL ::  datleg = .TRUE. !:
338    LOGICAL ::  grid = .TRUE.   !:
339    LOGICAL ::  lclose = .TRUE. !:
340    LOGICAL ::  rand = .TRUE.   !:
341    LOGICAL ::  swap = .TRUE.   !:
342    LOGICAL ::  twoxa = .TRUE.  !:
343    LOGICAL ::  xlog = .TRUE.   !:
344    LOGICAL ::  ylog = .TRUE.   !:
345   
346    REAL(wp) ::  gwid = 0.1_wp    !:
347    REAL(wp) ::  rlegfak = 0.7_wp !:
348    REAL(wp) ::  uxmin            !:
349    REAL(wp) ::  uxmax            !:
350    REAL(wp) ::  uymin            !:
351    REAL(wp) ::  uymax            !:
352     
353    REAL(wp), DIMENSION(1:100) ::  lwid = 0.6_wp !:
354    REAL(wp), DIMENSION(100)   ::  uyma          !:
355    REAL(wp), DIMENSION(100)   ::  uymi          !:
356
357    NAMELIST /RAHMEN/  cranz, datleg, rtext, swap
358    NAMELIST /CROSS/   rand, cucol, grid, gwid, klist, labforx, labfory,      &
359                       legpos, lclose, lstyle, lwid, rlegfak, timodex, utext, &
360                       uxmin, uxmax, uymin, uymax, twoxa, xlog, xtext, ylog,  &
361                       ytext
362
363
364    rtext = '\0.5 ' // run_description_header
365
366!
367!-- Open parameter- and data-file
368    CALL check_open( 81 )
369    CALL check_open( 82 )
370
371!
372!-- Write file header,
373!-- write RAHMEN-parameters (pr=3: w-array is on zw, other arrys on zu,
374!-- pr serves as an index for output of strings (axis-labels) of the
375!-- different quantities u, v, w, pt and q)
376    DO  k = 1, n_sp_x
377       IF ( k < 100 )  THEN
378          IF ( pr == 3 )  THEN
379             WRITE ( 82, 100 )  '#', k, header_char( pr ),        &
380                                INT( zw(comp_spectra_level(k)) ), &
381                                simulated_time_chr
382          ELSE
383             WRITE ( 82, 100 )  '#', k, header_char( pr ),        &
384                                INT( zu(comp_spectra_level(k)) ), &
385                                simulated_time_chr
386          ENDIF
387       ELSE
388          IF ( pr == 3 )  THEN
389             WRITE ( 82, 101 )  '#', k, header_char( pr ),        &
390                                INT( zw(comp_spectra_level(k)) ), &
391                                simulated_time_chr
392          ELSE
393             WRITE ( 82, 101 )  '#', k, header_char( pr ),        &
394                                INT( zu(comp_spectra_level(k)) ), &
395                                simulated_time_chr
396          ENDIF
397       ENDIF
398    ENDDO
399
400    IF ( .NOT. frame_written )  THEN
401       WRITE ( 81, RAHMEN )
402       frame_written = .TRUE.
403    ENDIF
404
405!
406!-- Write all data and calculate uymi and uyma. They serve to calculate
407!-- the CROSS-parameters uymin and uymax
408    uymi = 999.999_wp; uyma = -999.999_wp
409    DO  i = 1, nx/2
410       frequency = 2.0_wp * pi * i / ( dx * ( nx + 1 ) )
411       WRITE ( 82, 102 )  frequency, ( frequency * spectrum_x(i,k,m), k = 1, &
412                          n_sp_x )
413       DO  k = 1, n_sp_x
414          uymi(k) = MIN( uymi(k), frequency * spectrum_x(i,k,m) )
415          uyma(k) = MAX( uyma(k), frequency * spectrum_x(i,k,m) )
416       ENDDO
417    ENDDO
418
419!
420!-- Determine CROSS-parameters
421    cucol(1:n_sp_x)  = (/ ( k, k = 1, n_sp_x ) /)
422    lstyle(1:n_sp_x) = (/ ( lstyles(k), k = 1, n_sp_x ) /)
423
424!
425!-- Calculate klist-values from the available comp_spectra_level values
426    i = 1; k = 1
427    DO WHILE ( i <= 100  .AND.  plot_spectra_level(i) /= 999999 )
428       DO WHILE ( k <= n_sp_x  .AND. &
429                  plot_spectra_level(i) >= comp_spectra_level(k) )
430          IF ( plot_spectra_level(i) == comp_spectra_level(k) )  THEN
431             klist(i) = k + klist_x
432          ELSE
433             uymi(k) =  999.999_wp
434             uyma(k) = -999.999_wp
435          ENDIF
436          k = k + 1
437       ENDDO
438       i = i + 1
439    ENDDO
440    uymi(k:n_sp_x) =  999.999_wp
441    uyma(k:n_sp_x) = -999.999_wp
442    utext = 'x'//utext_char( pr )
443    IF ( averaging_interval_sp /= 0.0_wp ) THEN
444       WRITE ( atext, 104 )  averaging_interval_sp
445       utext = TRIM(utext) // ',  ' // TRIM( atext )
446    ENDIF
447    uxmin = 0.8_wp * 2.0_wp * pi        / ( dx * ( nx + 1 ) )
448    uxmax = 1.2_wp * 2.0_wp * pi * nx/2 / ( dx * ( nx + 1 ) )
449    uymin = 0.8_wp * MIN (  999.999_wp, MINVAL ( uymi ) )
450    uymax = 1.2_wp * MAX ( -999.999_wp, MAXVAL ( uyma ) )
451    ytext = ytext_char( pr )
452
453!
454!-- Output of CROSS-parameters
455    WRITE ( 81, CROSS )
456
457!
458!-- Increase counter by the number of profiles written in the actual block
459    klist_x = klist_x + n_sp_x
460
461!
462!-- Write end-mark
463    WRITE ( 82, 103 )
464
465!
466!-- Close parameter- and data-file
467    CALL close_file( 81 )
468    CALL close_file( 82 )
469
470!
471!-- Formats
472100 FORMAT (A,I1,1X,A,1X,I4,'m ',A)
473101 FORMAT (A,I2,1X,A,1X,I4,'m ',A)
474102 FORMAT (E15.7,100(1X,E15.7))
475103 FORMAT ('NEXT')
476104 FORMAT ('time averaged over',F7.1,' s')
477
478 END SUBROUTINE data_output_spectra_x
479
480
481 SUBROUTINE data_output_spectra_y( m, cranz, pr, frame_written )
482
483    USE arrays_3d,                                                             &
484        ONLY:  zu, zw
485 
486    USE constants,                                                             &
487        ONLY:  pi
488
489    USE control_parameters,                                                    &
490        ONLY:  averaging_interval_sp, run_description_header, simulated_time_chr
491
492    USE grid_variables,                                                        &
493        ONLY:  dy
494
495    USE indices,                                                               &
496        ONLY:  ny
497
498    USE kinds
499
500    USE pegrid
501   
502    USE statistics,                                                             &
503        ONLY:  spectrum_y
504
505    USE spectrum,                                                              &
506        ONLY:  comp_spectra_level, header_char, klist_y, lstyles, n_sp_y,      &
507               plot_spectra_level, utext_char, ytext_char
508
509    IMPLICIT NONE
510
511   
512    CHARACTER (LEN=30) ::  atext !:
513   
514    INTEGER(iwp)       ::  i     !:
515    INTEGER(iwp)       ::  j     !:
516    INTEGER(iwp)       ::  k     !:
517    INTEGER(iwp)       ::  m     !:
518    INTEGER(iwp)       ::  pr    !:
519   
520    LOGICAL            :: frame_written   !:
521   
522    REAL(wp)           :: frequency = 0.0_wp !:
523
524!
525!-- Variables needed for PROFIL-namelist
526    CHARACTER (LEN=80) ::  rtext                !:
527    CHARACTER (LEN=80) ::  utext                !:
528    CHARACTER (LEN=80) ::  xtext = 'k in m>->1' !:
529    CHARACTER (LEN=80) ::  ytext                !:
530
531    INTEGER(iwp) ::  cranz       !:
532    INTEGER(iwp) ::  labforx = 3 !:
533    INTEGER(iwp) ::  labfory = 3 !:
534    INTEGER(iwp) ::  legpos  = 3 !:
535    INTEGER(iwp) ::  timodex = 1 !:
536   
537    INTEGER(iwp), DIMENSION(1:100) ::  cucol  = 1      !:
538    INTEGER(iwp), DIMENSION(1:100) ::  klist  = 999999 !:
539    INTEGER(iwp), DIMENSION(1:100) ::  lstyle = 0      !:
540   
541    LOGICAL ::  datleg = .TRUE. !:
542    LOGICAL ::  grid = .TRUE.   !:
543    LOGICAL ::  lclose = .TRUE. !:
544    LOGICAL ::  rand = .TRUE.   !:
545    LOGICAL ::  swap = .TRUE.   !:
546    LOGICAL ::  twoxa = .TRUE.  !:
547    LOGICAL ::  xlog = .TRUE.   !:
548    LOGICAL ::  ylog = .TRUE.   !:
549   
550    REAL(wp) ::  gwid = 0.1_wp     !:
551    REAL(wp) ::  rlegfak = 0.7_wp  !:
552    REAL(wp) ::  uxmin             !:
553    REAL(wp) ::  uxmax             !:
554    REAL(wp) ::  uymin             !:
555    REAL(wp) ::  uymax             !:
556   
557    REAL(wp), DIMENSION(1:100) ::  lwid = 0.6_wp !:
558   
559    REAL(wp), DIMENSION(100)   ::  uyma          !:
560    REAL(wp), DIMENSION(100)   ::  uymi          !:
561
562    NAMELIST /RAHMEN/  cranz, datleg, rtext, swap
563    NAMELIST /CROSS/   rand, cucol, grid, gwid, klist, labforx, labfory,      &
564                       legpos, lclose, lstyle, lwid, rlegfak, timodex, utext, &
565                       uxmin, uxmax, uymin, uymax, twoxa, xlog, xtext, ylog,  &
566                       ytext
567
568
569    rtext = '\0.5 ' // run_description_header
570
571!
572!-- Open parameter- and data-file
573    CALL check_open( 83 )
574    CALL check_open( 84 )
575
576!
577!-- Write file header,
578!-- write RAHMEN-parameters (pr=3: w-array is on zw, other arrys on zu,
579!-- pr serves as an index for output of strings (axis-labels) of the
580!-- different quantities u, v, w, pt and q)
581    DO  k = 1, n_sp_y
582       IF ( k < 100 )  THEN
583          IF ( pr == 3 ) THEN
584             WRITE ( 84, 100 )  '#', k, header_char( pr ),        &
585                                INT( zw(comp_spectra_level(k)) ), &
586                                simulated_time_chr
587          ELSE
588             WRITE ( 84, 100 )  '#', k, header_char( pr ),        &
589                                INT( zu(comp_spectra_level(k)) ), &
590                                simulated_time_chr
591          ENDIF
592       ELSE
593          IF ( pr == 3 )  THEN
594             WRITE ( 84, 101 )  '#', k, header_char( pr ),        &
595                                INT( zw(comp_spectra_level(k)) ), &
596                                simulated_time_chr
597          ELSE
598             WRITE ( 84, 101 )  '#', k, header_char( pr ),        &
599                                INT( zu(comp_spectra_level(k)) ), &
600                                simulated_time_chr
601          ENDIF
602       ENDIF
603    ENDDO
604
605    IF ( .NOT. frame_written )  THEN
606       WRITE ( 83, RAHMEN )
607       frame_written = .TRUE.
608    ENDIF
609
610!
611!-- Write all data and calculate uymi and uyma. They serve to calculate
612!-- the CROSS-parameters uymin and uymax
613    uymi = 999.999_wp; uyma = -999.999_wp
614    DO  j = 1, ny/2
615       frequency = 2.0_wp * pi * j / ( dy * ( ny + 1 ) )
616       WRITE ( 84, 102 ) frequency, ( frequency * spectrum_y(j,k,m), &
617                                      k = 1, n_sp_y ) 
618       DO k = 1, n_sp_y
619          uymi(k) = MIN( uymi(k), frequency * spectrum_y(j,k,m) )
620          uyma(k) = MAX( uyma(k), frequency * spectrum_y(j,k,m) )
621       ENDDO
622    ENDDO
623
624!
625!-- Determine CROSS-parameters
626    cucol(1:n_sp_y)  = (/ ( k, k = 1, n_sp_y ) /)
627    lstyle(1:n_sp_y) = (/ ( lstyles(k), k = 1, n_sp_y ) /)
628
629!
630!-- Calculate klist-values from the available comp_spectra_level values
631    j = 1; k = 1
632    DO WHILE ( j <= 100  .AND.  plot_spectra_level(j) /= 999999 )
633       DO WHILE ( k <= n_sp_y  .AND. &
634                  plot_spectra_level(j) >= comp_spectra_level(k) )
635          IF ( plot_spectra_level(j) == comp_spectra_level(k) )  THEN
636             klist(j) = k + klist_y
637          ELSE
638             uymi(k) =  999.999_wp
639             uyma(k) = -999.999_wp
640          ENDIF
641          k = k + 1
642       ENDDO
643       j = j + 1
644    ENDDO
645    uymi(k:n_sp_y) =  999.999_wp
646    uyma(k:n_sp_y) = -999.999_wp
647    utext = 'y'//utext_char( pr )
648    IF ( averaging_interval_sp /= 0.0_wp )  THEN
649       WRITE ( atext, 104 )  averaging_interval_sp
650       utext = TRIM(utext) // ',  ' // TRIM( atext )
651    ENDIF
652    uxmin = 0.8_wp * 2.0_wp * pi        / ( dy * ( ny + 1 ) )
653    uxmax = 1.2_wp * 2.0_wp * pi * ny/2 / ( dy * ( ny + 1 ) )
654    uymin = 0.8_wp * MIN (  999.999_wp, MINVAL ( uymi ) )
655    uymax = 1.2_wp * MAX ( -999.999_wp, MAXVAL ( uyma ) )
656    ytext = ytext_char( pr )
657
658!
659!-- Output CROSS-parameters
660    WRITE ( 83, CROSS )
661
662!
663!-- Increase counter by the number of profiles written in the actual block
664    klist_y = klist_y + n_sp_y
665
666!
667!-- Write end-mark
668    WRITE ( 84, 103 ) 
669
670!
671!-- Close parameter- and data-file
672    CALL close_file( 83 )
673    CALL close_file( 84 )
674
675!
676!-- Formats
677100 FORMAT (A,I1,1X,A,1X,I4,'m ',A)
678101 FORMAT (A,I2,1X,A,1X,I4,'m ',A)
679102 FORMAT (E15.7,100(1X,E15.7))
680103 FORMAT ('NEXT')
681104 FORMAT ('time averaged over',F7.1,' s')
682
683 END SUBROUTINE data_output_spectra_y
684#endif
Note: See TracBrowser for help on using the repository browser.