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

Last change on this file since 263 was 263, checked in by heinze, 13 years ago

Output of NetCDF messages with aid of message handling routine.

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