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

Last change on this file since 964 was 964, checked in by raasch, 12 years ago

old profil-parameters (cross_xtext, cross_normalized_x, etc. ) and respective code removed
(check_open, check_parameters, close_file, data_output_profiles, data_output_spectra, header, modules, parin)

reformatting (netcdf)

append feature removed from unit 14 (check_open)

  • Property svn:keywords set to Id
File size: 15.7 KB
Line 
1 SUBROUTINE data_output_spectra
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6! code for profil-output removed
7!
8! Former revisions:
9! -----------------
10! $Id: data_output_spectra.f90 964 2012-07-26 09:14:24Z raasch $
11!
12! 291 2009-04-16 12:07:26Z raasch
13! simulated_time in NetCDF output replaced by time_since_reference_point.
14! Output of NetCDF messages with aid of message handling routine.
15! Output of messages replaced by message handling routine.
16!
17! 189 2008-08-13 17:09:26Z letzel
18! allow 100 spectra levels instead of 10 for consistency with
19! define_netcdf_header, +user-defined spectra
20!
21! February 2007
22! RCS Log replace by Id keyword, revision history cleaned up
23!
24! Revision 1.7  2006/04/11 14:56:38  raasch
25! pl_spectra renamed data_output_sp
26!
27! Revision 1.1  2001/01/05 15:14:20  raasch
28! Initial revision
29!
30!
31! Description:
32! ------------
33! Writing spectra data on file, using a special format which allows
34! plotting of these data with PROFIL-graphic-software
35!------------------------------------------------------------------------------!
36#if defined( __spectra )
37
38    USE arrays_3d
39    USE control_parameters
40    USE cpulog
41    USE interfaces
42    USE netcdf_control
43    USE pegrid
44    USE spectrum
45    USE statistics
46
47
48    IMPLICIT NONE
49
50    INTEGER :: m, pr, cranz_x, cranz_y
51    LOGICAL :: frame_x, frame_y
52
53    CALL cpu_log( log_point(31), 'data_output_spectra', 'start' )
54
55!
56!-- Output is only performed on PE0
57    IF ( myid == 0 )  THEN
58
59!
60!--    Open file for spectra output in NetCDF format
61       IF ( netcdf_output )  CALL check_open( 107 )
62
63!
64!--    Increment the counter for number of output times
65       dosp_time_count = dosp_time_count + 1
66
67#if defined( __netcdf )
68!
69!--    Update the spectra time axis
70       nc_stat = NF90_PUT_VAR( id_set_sp, id_var_time_sp,        &
71                               (/ time_since_reference_point /), &
72                               start = (/ dosp_time_count /), count = (/ 1 /) )
73       CALL handle_netcdf_error( 'data_output_spectra', 47 )
74#endif
75
76!
77!--    If necessary, calculate time average and reset average counter
78       IF ( average_count_sp == 0 )  THEN
79           message_string = 'no spectra data available'
80           CALL message( 'data_output_spectra', 'PA0186', 0, 0, 0, 6, 0 )
81       ENDIF
82       IF ( average_count_sp /= 1 )  THEN
83          spectrum_x = spectrum_x / REAL( average_count_sp )
84          spectrum_y = spectrum_y / REAL( average_count_sp )
85          average_count_sp = 0
86       ENDIF
87
88!
89!--    Loop over all spectra defined by the user
90       m = 1
91       DO WHILE ( data_output_sp(m) /= ' '  .AND.  m <= 10 )
92
93          SELECT CASE ( TRIM( data_output_sp(m) ) )
94
95             CASE ( 'u' )
96                pr = 1
97
98             CASE ( 'v' )
99                pr = 2
100
101             CASE ( 'w' )
102                pr = 3
103
104             CASE ( 'pt' )
105                pr = 4
106
107             CASE ( 'q' )
108                pr = 5
109
110             CASE DEFAULT
111!
112!--             The DEFAULT case is reached either if the parameter
113!--             data_output_sp(m) contains a wrong character string or if the
114!--             user has coded a special case in the user interface. There, the
115!--             subroutine user_spectra checks which of these two conditions
116!--             applies.
117                CALL user_spectra( 'data_output', m, pr )
118
119          END SELECT
120
121!
122!--       Output of spectra in NetCDF format
123          IF ( netcdf_output )  THEN
124!
125!--          Output of x-spectra
126             IF ( INDEX( spectra_direction(m), 'x' ) /= 0 ) THEN
127                CALL output_spectra_netcdf( m, 'x' )
128             ENDIF
129!
130!--          Output of y-spectra
131             IF ( INDEX( spectra_direction(m), 'y' ) /= 0 ) THEN
132                CALL output_spectra_netcdf( m, 'y' )
133             ENDIF
134          ENDIF
135
136!
137!--       Increase counter for next spectrum
138          m = m + 1
139
140       ENDDO
141
142!
143!--    Reset spectra values
144       spectrum_x = 0.0; spectrum_y = 0.0
145
146    ENDIF
147
148    CALL cpu_log( log_point(31), 'data_output_spectra', 'stop' )
149
150#if defined( __parallel )
151!    CALL MPI_BARRIER( comm2d, ierr )  ! really necessary
152#endif
153
154#endif
155 END SUBROUTINE data_output_spectra
156
157
158 SUBROUTINE output_spectra_netcdf( nsp, direction )
159#if defined( __netcdf )
160
161    USE constants
162    USE control_parameters
163    USE grid_variables
164    USE indices
165    USE netcdf_control
166    USE spectrum
167    USE statistics
168
169    IMPLICIT NONE
170
171    CHARACTER (LEN=1), INTENT(IN) ::  direction
172
173    INTEGER, INTENT(IN) ::  nsp
174
175    INTEGER ::  i, k
176
177    REAL ::  frequency
178
179    REAL, DIMENSION(nx/2) ::  netcdf_data_x
180    REAL, DIMENSION(ny/2) ::  netcdf_data_y
181
182
183    IF ( direction == 'x' )  THEN
184
185       DO  k = 1, n_sp_x
186
187          DO  i = 1, nx/2
188             frequency = 2.0 * pi * i / ( dx * ( nx + 1 ) )
189             netcdf_data_x(i) = frequency * spectrum_x(i,k,nsp)
190          ENDDO
191
192          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_dospx(nsp), netcdf_data_x, &
193                                  start = (/ 1, k, dosp_time_count /), &
194                                  count = (/ nx/2, 1, 1 /) )
195          CALL handle_netcdf_error( 'data_output_spectra', 348 )
196
197       ENDDO
198
199    ENDIF
200
201    IF ( direction == 'y' )  THEN
202
203       DO  k = 1, n_sp_y
204
205          DO  i = 1, ny/2
206             frequency = 2.0 * pi * i / ( dy * ( ny + 1 ) )
207             netcdf_data_y(i) = frequency * spectrum_y(i,k,nsp)
208          ENDDO
209
210          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_dospy(nsp), netcdf_data_y, &
211                                  start = (/ 1, k, dosp_time_count /), &
212                                  count = (/ ny/2, 1, 1 /) )
213          CALL handle_netcdf_error( 'data_output_spectra', 349 )
214
215       ENDDO
216
217    ENDIF
218
219#endif
220 END SUBROUTINE output_spectra_netcdf
221
222
223#if defined( __spectra )
224 SUBROUTINE data_output_spectra_x( m, cranz, pr, frame_written )
225
226    USE arrays_3d
227    USE constants
228    USE control_parameters
229    USE grid_variables
230    USE indices
231    USE pegrid
232    USE singleton
233    USE spectrum
234    USE statistics
235    USE transpose_indices
236
237    IMPLICIT NONE
238
239    CHARACTER (LEN=30) ::  atext
240    INTEGER            ::  i, j, k, m, pr
241    LOGICAL            ::  frame_written
242    REAL               ::  frequency = 0.0
243
244!
245!-- Variables needed for PROFIL-namelist
246    INTEGER                  :: cranz, labforx = 3, labfory = 3, legpos = 3, &
247                                timodex = 1
248    INTEGER, DIMENSION(1:100):: cucol = 1, klist = 999999, lstyle = 0
249    LOGICAL                  :: datleg = .TRUE., grid = .TRUE., &
250                                lclose = .TRUE., rand = .TRUE., &
251                                swap = .TRUE., twoxa = .TRUE.,  &
252                                xlog = .TRUE., ylog = .TRUE.
253    CHARACTER (LEN=80)       :: rtext, utext, xtext = 'k in m>->1', ytext
254    REAL                     :: gwid = 0.1, rlegfak = 0.7, uxmin, uxmax, &
255                                uymin, uymax
256    REAL, DIMENSION(1:100)   :: lwid = 0.6
257    REAL, DIMENSION(100)     :: uyma, uymi
258
259    NAMELIST /RAHMEN/  cranz, datleg, rtext, swap
260    NAMELIST /CROSS/   rand, cucol, grid, gwid, klist, labforx, labfory,      &
261                       legpos, lclose, lstyle, lwid, rlegfak, timodex, utext, &
262                       uxmin, uxmax, uymin, uymax, twoxa, xlog, xtext, ylog,  &
263                       ytext
264
265
266    rtext = '\0.5 ' // run_description_header
267
268!
269!-- Open parameter- and data-file
270    CALL check_open( 81 )
271    CALL check_open( 82 )
272
273!
274!-- Write file header,
275!-- write RAHMEN-parameters (pr=3: w-array is on zw, other arrys on zu,
276!-- pr serves as an index for output of strings (axis-labels) of the
277!-- different quantities u, v, w, pt and q)
278    DO  k = 1, n_sp_x
279       IF ( k < 100 )  THEN
280          IF ( pr == 3 )  THEN
281             WRITE ( 82, 100 )  '#', k, header_char( pr ),        &
282                                INT( zw(comp_spectra_level(k)) ), &
283                                simulated_time_chr
284          ELSE
285             WRITE ( 82, 100 )  '#', k, header_char( pr ),        &
286                                INT( zu(comp_spectra_level(k)) ), &
287                                simulated_time_chr
288          ENDIF
289       ELSE
290          IF ( pr == 3 )  THEN
291             WRITE ( 82, 101 )  '#', k, header_char( pr ),        &
292                                INT( zw(comp_spectra_level(k)) ), &
293                                simulated_time_chr
294          ELSE
295             WRITE ( 82, 101 )  '#', k, header_char( pr ),        &
296                                INT( zu(comp_spectra_level(k)) ), &
297                                simulated_time_chr
298          ENDIF
299       ENDIF
300    ENDDO
301
302    IF ( .NOT. frame_written )  THEN
303       WRITE ( 81, RAHMEN )
304       frame_written = .TRUE.
305    ENDIF
306
307!
308!-- Write all data and calculate uymi and uyma. They serve to calculate
309!-- the CROSS-parameters uymin and uymax
310    uymi = 999.999; uyma = -999.999
311    DO  i = 1, nx/2
312       frequency = 2.0 * pi * i / ( dx * ( nx + 1 ) )
313       WRITE ( 82, 102 )  frequency, ( frequency * spectrum_x(i,k,m), k = 1, &
314                          n_sp_x )
315       DO  k = 1, n_sp_x
316          uymi(k) = MIN( uymi(k), frequency * spectrum_x(i,k,m) )
317          uyma(k) = MAX( uyma(k), frequency * spectrum_x(i,k,m) )
318       ENDDO
319    ENDDO
320
321!
322!-- Determine CROSS-parameters
323    cucol(1:n_sp_x)  = (/ ( k, k = 1, n_sp_x ) /)
324    lstyle(1:n_sp_x) = (/ ( lstyles(k), k = 1, n_sp_x ) /)
325
326!
327!-- Calculate klist-values from the available comp_spectra_level values
328    i = 1; k = 1
329    DO WHILE ( i <= 100  .AND.  plot_spectra_level(i) /= 999999 )
330       DO WHILE ( k <= n_sp_x  .AND. &
331                  plot_spectra_level(i) >= comp_spectra_level(k) )
332          IF ( plot_spectra_level(i) == comp_spectra_level(k) )  THEN
333             klist(i) = k + klist_x
334          ELSE
335             uymi(k) =  999.999
336             uyma(k) = -999.999
337          ENDIF
338          k = k + 1
339       ENDDO
340       i = i + 1
341    ENDDO
342    uymi(k:n_sp_x) =  999.999
343    uyma(k:n_sp_x) = -999.999
344    utext = 'x'//utext_char( pr )
345    IF ( averaging_interval_sp /= 0.0 ) THEN
346       WRITE ( atext, 104 )  averaging_interval_sp
347       utext = TRIM(utext) // ',  ' // TRIM( atext )
348    ENDIF
349    uxmin = 0.8 * 2.0 * pi        / ( dx * ( nx + 1 ) )
350    uxmax = 1.2 * 2.0 * pi * nx/2 / ( dx * ( nx + 1 ) )
351    uymin = 0.8 * MIN (  999.999, MINVAL ( uymi ) )
352    uymax = 1.2 * MAX ( -999.999, MAXVAL ( uyma ) )
353    ytext = ytext_char( pr )
354
355!
356!-- Output of CROSS-parameters
357    WRITE ( 81, CROSS )
358
359!
360!-- Increase counter by the number of profiles written in the actual block
361    klist_x = klist_x + n_sp_x
362
363!
364!-- Write end-mark
365    WRITE ( 82, 103 )
366
367!
368!-- Close parameter- and data-file
369    CALL close_file( 81 )
370    CALL close_file( 82 )
371
372!
373!-- Formats
374100 FORMAT (A,I1,1X,A,1X,I4,'m ',A)
375101 FORMAT (A,I2,1X,A,1X,I4,'m ',A)
376102 FORMAT (E15.7,100(1X,E15.7))
377103 FORMAT ('NEXT')
378104 FORMAT ('time averaged over',F7.1,' s')
379
380 END SUBROUTINE data_output_spectra_x
381
382
383 SUBROUTINE data_output_spectra_y( m, cranz, pr, frame_written )
384
385    USE arrays_3d
386    USE constants
387    USE control_parameters
388    USE grid_variables
389    USE indices
390    USE pegrid
391    USE singleton
392    USE spectrum
393    USE statistics
394    USE transpose_indices
395
396    IMPLICIT NONE
397
398    CHARACTER (LEN=30) ::  atext
399    INTEGER            :: i, j, k, m, pr
400    LOGICAL            :: frame_written
401    REAL               :: frequency = 0.0
402
403!
404!-- Variables needed for PROFIL-namelist
405    INTEGER                  :: cranz, labforx = 3, labfory = 3, legpos = 3, &
406                                timodex = 1
407    INTEGER, DIMENSION(1:100):: cucol = 1, klist = 999999, lstyle = 0
408    LOGICAL                  :: datleg = .TRUE., grid = .TRUE., &
409                                lclose = .TRUE., rand = .TRUE., &
410                                swap = .TRUE., twoxa = .TRUE.,  &
411                                xlog = .TRUE., ylog = .TRUE.
412    CHARACTER (LEN=80)       :: rtext, utext, xtext = 'k in m>->1', ytext
413    REAL                     :: gwid = 0.1, rlegfak = 0.7, uxmin, uxmax, &
414                                uymin, uymax
415    REAL, DIMENSION(1:100)   :: lwid = 0.6
416    REAL, DIMENSION(100)     :: uyma, uymi
417
418    NAMELIST /RAHMEN/  cranz, datleg, rtext, swap
419    NAMELIST /CROSS/   rand, cucol, grid, gwid, klist, labforx, labfory,      &
420                       legpos, lclose, lstyle, lwid, rlegfak, timodex, utext, &
421                       uxmin, uxmax, uymin, uymax, twoxa, xlog, xtext, ylog,  &
422                       ytext
423
424
425    rtext = '\0.5 ' // run_description_header
426
427!
428!-- Open parameter- and data-file
429    CALL check_open( 83 )
430    CALL check_open( 84 )
431
432!
433!-- Write file header,
434!-- write RAHMEN-parameters (pr=3: w-array is on zw, other arrys on zu,
435!-- pr serves as an index for output of strings (axis-labels) of the
436!-- different quantities u, v, w, pt and q)
437    DO  k = 1, n_sp_y
438       IF ( k < 100 )  THEN
439          IF ( pr == 3 ) THEN
440             WRITE ( 84, 100 )  '#', k, header_char( pr ),        &
441                                INT( zw(comp_spectra_level(k)) ), &
442                                simulated_time_chr
443          ELSE
444             WRITE ( 84, 100 )  '#', k, header_char( pr ),        &
445                                INT( zu(comp_spectra_level(k)) ), &
446                                simulated_time_chr
447          ENDIF
448       ELSE
449          IF ( pr == 3 )  THEN
450             WRITE ( 84, 101 )  '#', k, header_char( pr ),        &
451                                INT( zw(comp_spectra_level(k)) ), &
452                                simulated_time_chr
453          ELSE
454             WRITE ( 84, 101 )  '#', k, header_char( pr ),        &
455                                INT( zu(comp_spectra_level(k)) ), &
456                                simulated_time_chr
457          ENDIF
458       ENDIF
459    ENDDO
460
461    IF ( .NOT. frame_written )  THEN
462       WRITE ( 83, RAHMEN )
463       frame_written = .TRUE.
464    ENDIF
465
466!
467!-- Write all data and calculate uymi and uyma. They serve to calculate
468!-- the CROSS-parameters uymin and uymax
469    uymi = 999.999; uyma = -999.999
470    DO  j = 1, ny/2
471       frequency = 2.0 * pi * j / ( dy * ( ny + 1 ) )
472       WRITE ( 84, 102 ) frequency, ( frequency * spectrum_y(j,k,m), &
473                                      k = 1, n_sp_y ) 
474       DO k = 1, n_sp_y
475          uymi(k) = MIN( uymi(k), frequency * spectrum_y(j,k,m) )
476          uyma(k) = MAX( uyma(k), frequency * spectrum_y(j,k,m) )
477       ENDDO
478    ENDDO
479
480!
481!-- Determine CROSS-parameters
482    cucol(1:n_sp_y)  = (/ ( k, k = 1, n_sp_y ) /)
483    lstyle(1:n_sp_y) = (/ ( lstyles(k), k = 1, n_sp_y ) /)
484
485!
486!-- Calculate klist-values from the available comp_spectra_level values
487    j = 1; k = 1
488    DO WHILE ( j <= 100  .AND.  plot_spectra_level(j) /= 999999 )
489       DO WHILE ( k <= n_sp_y  .AND. &
490                  plot_spectra_level(j) >= comp_spectra_level(k) )
491          IF ( plot_spectra_level(j) == comp_spectra_level(k) )  THEN
492             klist(j) = k + klist_y
493          ELSE
494             uymi(k) =  999.999
495             uyma(k) = -999.999
496          ENDIF
497          k = k + 1
498       ENDDO
499       j = j + 1
500    ENDDO
501    uymi(k:n_sp_y) =  999.999
502    uyma(k:n_sp_y) = -999.999
503    utext = 'y'//utext_char( pr )
504    IF ( averaging_interval_sp /= 0.0 )  THEN
505       WRITE ( atext, 104 )  averaging_interval_sp
506       utext = TRIM(utext) // ',  ' // TRIM( atext )
507    ENDIF
508    uxmin = 0.8 * 2.0 * pi        / ( dy * ( ny + 1 ) )
509    uxmax = 1.2 * 2.0 * pi * ny/2 / ( dy * ( ny + 1 ) )
510    uymin = 0.8 * MIN (  999.999, MINVAL ( uymi ) )
511    uymax = 1.2 * MAX ( -999.999, MAXVAL ( uyma ) )
512    ytext = ytext_char( pr )
513
514!
515!-- Output CROSS-parameters
516    WRITE ( 83, CROSS )
517
518!
519!-- Increase counter by the number of profiles written in the actual block
520    klist_y = klist_y + n_sp_y
521
522!
523!-- Write end-mark
524    WRITE ( 84, 103 ) 
525
526!
527!-- Close parameter- and data-file
528    CALL close_file( 83 )
529    CALL close_file( 84 )
530
531!
532!-- Formats
533100 FORMAT (A,I1,1X,A,1X,I4,'m ',A)
534101 FORMAT (A,I2,1X,A,1X,I4,'m ',A)
535102 FORMAT (E15.7,100(1X,E15.7))
536103 FORMAT ('NEXT')
537104 FORMAT ('time averaged over',F7.1,' s')
538
539 END SUBROUTINE data_output_spectra_y
540#endif
Note: See TracBrowser for help on using the repository browser.