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

Last change on this file since 1444 was 1354, checked in by heinze, 11 years ago

last commit documented

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