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

Last change on this file since 1786 was 1786, checked in by raasch, 6 years ago

pmc-change in server-client get-put, spectra-directives removed, spectra-package modularized

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