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

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

last commit documented

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