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

Last change on this file since 1318 was 1318, checked in by raasch, 8 years ago

former files/routines cpu_log and cpu_statistics combined to one module,
which also includes the former data module cpulog from the modules-file,
module interfaces removed

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