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

Last change on this file since 1811 was 1787, checked in by raasch, 9 years ago

last commit documented

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