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

Last change on this file since 684 was 392, checked in by raasch, 15 years ago

New:
---

Adapted for machine lck
(mrun, mbuild, subjob)

bc_lr/bc_ns in most subroutines replaced by LOGICAL variables bc_lr_cyc,
bc_ns_cyc for speed optimization
(check_parameters, diffusion_u, diffusion_v, diffusion_w, modules)

Additional timestep criterion in case of simulations with plant canopy (timestep)

Check for illegal entries in section_xy|xz|yz that exceed nz+1|ny+1|nx+1
(check_parameters)

Clipping of dvrp output implemented. Default colourtable for particles
implemented, particle attributes (color, dvrp_size) can be set with new
parameters particle_color, particle_dvrpsize, color_interval,
dvrpsize_interval (init_dvrp, data_output_dvrp, modules, user_data_output_dvrp).
Slicer attributes (dvrp) are set with new routine set_slicer_attributes_dvrp
and are controlled with existing parameters slicer_range_limits.
(set_slicer_attributes_dvrp)

Ocean atmosphere coupling allows to use independent precursor runs in order
to account for different spin-up times. The time when coupling has to be
started is given by new inipar parameter coupling_start_time. The precursor
ocean run has to be started using new mrun option "-y" in order to add
appendix "_O" to all output files.
(check_for_restart, check_parameters, data_output_2d, data_output_3d,
data_output_profiles, data_output_ptseries, data_output_spectra,
data_output_tseries, header, init_coupling, modules, mrun,
parin, read_var_list, surface_coupler, time_integration, write_var_list)

Polygon reduction for topography and ground plate isosurface. Reduction level
for buildings can be chosen with parameter cluster_size. (init_dvrp)

External pressure gradient (check_parameters, header, init_3d_model, modules,
parin, prognostic_equations, read_var_list, write_var_list)

New topography case 'single_street_canyon' (header, init_grid, modules, parin,
read_var_list, user_check_parameters, user_header, user_init_grid, write_var_list)

Option to predefine a target bulk velocity for conserve_volume_flow
(check_parameters, header, init_3d_model, modules, parin, read_var_list,
write_var_list)

Option for user defined 2D data output in xy cross sections at z=nzb+1
(data_output_2d, user_data_output_2d)

xy cross section output of surface heatfluxes (latent, sensible)
(average_3d_data, check_parameters, data_output_2d, modules, read_3d_binary,
sum_up_3d_data, write_3d_binary)

average_3d_data, check_for_restart, check_parameters, data_output_2d, data_output_3d, data_output_dvrp, data_output_profiles, data_output_ptseries, data_output_spectra, data_output_tseries, init_coupling, init_dvrp, init_grid, init_3d_model, header, mbuild, modules, mrun, package_parin, parin, prognostic_equations, read_3d_binary, read_var_list, subjob, surface_coupler, timestep, time_integration, user_check_parameters, user_data_output_2d, user_data_output_dvrp, user_header, user_init_grid, write_3d_binary, write_var_list

New: set_particle_attributes, set_slicer_attributes_dvrp

Changed:


lcmuk changed to lc to avoid problems with Intel compiler on sgi-ice
(poisfft)

For extended NetCDF files, the updated title attribute includes an update of
time_average_text where appropriate. (netcdf)

In case of restart runs without extension, initial profiles are not written
to NetCDF-file anymore. (data_output_profiles, modules, read_var_list, write_var_list)

Small change in formatting of the message handling routine concering the output in the
job protocoll. (message)

initializing_actions='read_data_for_recycling' renamed to 'cyclic_fill', now
independent of turbulent_inflow (check_parameters, header, init_3d_model)

2 NetCDF error numbers changed. (data_output_3d)

A Link to the website appendix_a.html is printed for further information
about the possible errors. (message)

Temperature gradient criterion for estimating the boundary layer height
replaced by the gradient criterion of Sullivan et al. (1998). (flow_statistics)

NetCDF unit attribute in timeseries output in case of statistic regions added
(netcdf)

Output of NetCDF messages with aid of message handling routine.
(check_open, close_file, data_output_2d, data_output_3d,
data_output_profiles, data_output_ptseries, data_output_spectra,
data_output_tseries, netcdf, output_particles_netcdf)

Output of messages replaced by message handling routine.
(advec_particles, advec_s_bc, buoyancy, calc_spectra, check_for_restart,
check_open, coriolis, cpu_log, data_output_2d, data_output_3d, data_output_dvrp,
data_output_profiles, data_output_spectra, fft_xy, flow_statistics, header,
init_1d_model, init_3d_model, init_dvrp, init_grid, init_particles, init_pegrid,
netcdf, parin, plant_canopy_model, poisfft_hybrid, poismg, read_3d_binary,
read_var_list, surface_coupler, temperton_fft, timestep, user_actions,
user_data_output_dvrp, user_dvrp_coltab, user_init_grid, user_init_plant_canopy,
user_parin, user_read_restart_data, user_spectra )

Maximum number of tails is calculated from maximum number of particles and
skip_particles_for_tail (init_particles)

Value of vertical_particle_advection may differ for each particle group
(advec_particles, header, modules)

First constant in array den also defined as type double. (eqn_state_seawater)

Parameter dvrp_psize moved from particles_par to dvrp_graphics_par. (package_parin)

topography_grid_convention moved from userpar to inipar (check_parameters,
header, parin, read_var_list, user_check_parameters, user_header,
user_init_grid, user_parin, write_var_list)

Default value of grid_matching changed to strict.

Adjustments for runs on lcxt4 (necessary due to an software update on CRAY) and
for coupled runs on ibmy (mrun, subjob)

advec_particles, advec_s_bc, buoyancy, calc_spectra, check_for_restart, check_open, check_parameters, close_file, coriolis, cpu_log, data_output_2d, data_output_3d, data_output_dvrp, data_output_profiles, data_output_ptseries, data_output_spectra, data_output_tseries, eqn_state_seawater, fft_xy, flow_statistics, header, init_1d_model, init_3d_model, init_dvrp, init_grid, init_particles, init_pegrid, message, mrun, netcdf, output_particles_netcdf, package_parin, parin, plant_canopy_model, poisfft, poisfft_hybrid, poismg, read_3d_binary, read_var_list, sort_particles, subjob, user_check_parameters, user_header, user_init_grid, user_parin, surface_coupler, temperton_fft, timestep, user_actions, user_data_output_dvrp, user_dvrp_coltab, user_init_grid, user_init_plant_canopy, user_parin, user_read_restart_data, user_spectra, write_var_list

Errors:


Bugfix: Initial hydrostatic pressure profile in case of ocean runs is now
calculated in 5 iteration steps. (init_ocean)

Bugfix: wrong sign in buoyancy production of ocean part in case of not using
the reference density (only in 3D routine production_e) (production_e)

Bugfix: output of averaged 2d/3d quantities requires that an avaraging
interval has been set, respective error message is included (check_parameters)

Bugfix: Output on unit 14 only if requested by write_binary.
(user_last_actions)

Bugfix to avoid zero division by km_neutral (production_e)

Bugfix for extended NetCDF files: In order to avoid 'data mode' errors if
updated attributes are larger than their original size, NF90_PUT_ATT is called
in 'define mode' enclosed by NF90_REDEF and NF90_ENDDEF calls. This implies a
possible performance loss; an alternative strategy would be to ensure equal
attribute size in a job chain. (netcdf)

Bugfix: correction of initial volume flow for non-flat topography (init_3d_model)
Bugfix: zero initialization of arrays within buildings for 'cyclic_fill' (init_3d_model)

Bugfix: to_be_resorted => s_av for time-averaged scalars (data_output_2d, data_output_3d)

Bugfix: error in formatting the output (message)

Bugfix: avoid that ngp_2dh_s_inner becomes zero (init_3_model)

Typographical error: unit of wpt in dots_unit (modules)

Bugfix: error in check, if particles moved further than one subdomain length.
This check must not be applied for newly released particles. (advec_particles)

Bugfix: several tail counters are initialized, particle_tail_coordinates is
only written to file if its third index is > 0, arrays for tails are allocated
with a minimum size of 10 tails if there is no tail initially (init_particles,
advec_particles)

Bugfix: pressure included for profile output (check_parameters)

Bugfix: Type of count and count_rate changed to default INTEGER on NEC machines
(cpu_log)

Bugfix: output if particle time series only if particle advection is switched
on. (time_integration)

Bugfix: qsws was calculated in case of constant heatflux = .FALSE. (prandtl_fluxes)

Bugfix: averaging along z is not allowed for 2d quantities (e.g. u* and z0) (data_output_2d)

Typographical errors (netcdf)

If the inversion height calculated by the prerun is zero, inflow_damping_height
must be explicitly specified (init_3d_model)

Small bugfix concerning 3d 64bit netcdf output format (header)

Bugfix: dt_fixed removed from the restart file, because otherwise, no change
from a fixed to a variable timestep would be possible in restart runs.
(read_var_list, write_var_list)

Bugfix: initial setting of time_coupling in coupled restart runs (time_integration)

advec_particles, check_parameters, cpu_log, data_output_2d, data_output_3d, header, init_3d_model, init_particles, init_ocean, modules, netcdf, prandtl_fluxes, production_e, read_var_list, time_integration, user_last_actions, write_var_list

  • Property svn:keywords set to Id
File size: 16.7 KB
RevLine 
[1]1 SUBROUTINE data_output_spectra
2
3!------------------------------------------------------------------------------!
[254]4! Current revisions:
[1]5! -----------------
[392]6!
[1]7!
8! Former revisions:
9! -----------------
[3]10! $Id: data_output_spectra.f90 392 2009-09-24 10:39:14Z raasch $
[198]11!
[392]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!
[198]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
[3]22! RCS Log replace by Id keyword, revision history cleaned up
23!
[1]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
[291]70       nc_stat = NF90_PUT_VAR( id_set_sp, id_var_time_sp,        &
71                               (/ time_since_reference_point /), &
[1]72                               start = (/ dosp_time_count /), count = (/ 1 /) )
[263]73       CALL handle_netcdf_error( 'data_output_spectra', 47 )
[1]74#endif
75
76       IF ( profil_output )  THEN
77!
78!--       Compute RAHMEN-Parameter CRANZ for x- and y-spectra separately
79          cranz_x = 0; cranz_y = 0; frame_x = .FALSE.; frame_y = .FALSE.
80
81          m = 1
82          DO WHILE ( data_output_sp(m) /= ' ' .AND. m <= 10 )
83
84             IF ( INDEX( spectra_direction(m), 'x' ) /= 0 )  THEN
85                cranz_x = cranz_x + 1
86             ENDIF
87             IF ( INDEX( spectra_direction(m), 'y' ) /= 0 )  THEN
88                cranz_y = cranz_y + 1
89             ENDIF
90
91             m = m + 1
92
93          ENDDO
94
95       ENDIF
96
97!
98!--    If necessary, calculate time average and reset average counter
99       IF ( average_count_sp == 0 )  THEN
[254]100           message_string = 'no spectra data available'
101           CALL message( 'data_output_spectra', 'PA0186', 0, 0, 0, 6, 0 )
[1]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
[144]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 )
[1]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!--       Output of spectra in profil format
159          IF ( profil_output )  THEN
160!
161!--          Output of x-spectra
162             IF ( INDEX( spectra_direction(m), 'x' ) /= 0 ) THEN
163                CALL data_output_spectra_x( m, cranz_x, pr, frame_x )
164             ENDIF
165
166!
167!--          Output of y-spectra
168             IF ( INDEX( spectra_direction(m), 'y' ) /= 0 ) THEN
169                CALL data_output_spectra_y( m, cranz_y, pr, frame_y )
170             ENDIF
171          ENDIF
172
173!
174!--       Increase counter for next spectrum
175          m = m + 1
176
177       ENDDO
178
179!
180!--    Reset spectra values
181       spectrum_x = 0.0; spectrum_y = 0.0
182
183    ENDIF
184
185    CALL cpu_log( log_point(31), 'data_output_spectra', 'stop' )
186
187#if defined( __parallel )
188!    CALL MPI_BARRIER( comm2d, ierr )  ! really necessary
189#endif
190
191#endif
192 END SUBROUTINE data_output_spectra
193
194
195 SUBROUTINE output_spectra_netcdf( nsp, direction )
196#if defined( __netcdf )
197
198    USE constants
199    USE control_parameters
200    USE grid_variables
201    USE indices
202    USE netcdf_control
203    USE spectrum
204    USE statistics
205
206    IMPLICIT NONE
207
208    CHARACTER (LEN=1), INTENT(IN) ::  direction
209
210    INTEGER, INTENT(IN) ::  nsp
211
212    INTEGER ::  i, k
213
214    REAL ::  frequency
215
216    REAL, DIMENSION(nx/2) ::  netcdf_data_x
217    REAL, DIMENSION(ny/2) ::  netcdf_data_y
218
219
220    IF ( direction == 'x' )  THEN
221
222       DO  k = 1, n_sp_x
223
224          DO  i = 1, nx/2
225             frequency = 2.0 * pi * i / ( dx * ( nx + 1 ) )
226             netcdf_data_x(i) = frequency * spectrum_x(i,k,nsp)
227          ENDDO
228
229          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_dospx(nsp), netcdf_data_x, &
230                                  start = (/ 1, k, dosp_time_count /), &
231                                  count = (/ nx/2, 1, 1 /) )
[263]232          CALL handle_netcdf_error( 'data_output_spectra', 348 )
[1]233
234       ENDDO
235
236    ENDIF
237
238    IF ( direction == 'y' )  THEN
239
240       DO  k = 1, n_sp_y
241
242          DO  i = 1, ny/2
243             frequency = 2.0 * pi * i / ( dy * ( ny + 1 ) )
244             netcdf_data_y(i) = frequency * spectrum_y(i,k,nsp)
245          ENDDO
246
247          nc_stat = NF90_PUT_VAR( id_set_sp, id_var_dospy(nsp), netcdf_data_y, &
248                                  start = (/ 1, k, dosp_time_count /), &
249                                  count = (/ ny/2, 1, 1 /) )
[263]250          CALL handle_netcdf_error( 'data_output_spectra', 349 )
[1]251
252       ENDDO
253
254    ENDIF
255
256#endif
257 END SUBROUTINE output_spectra_netcdf
258
259
260#if defined( __spectra )
261 SUBROUTINE data_output_spectra_x( m, cranz, pr, frame_written )
262
263    USE arrays_3d
264    USE constants
265    USE control_parameters
266    USE grid_variables
267    USE indices
268    USE pegrid
269    USE singleton
270    USE spectrum
271    USE statistics
272    USE transpose_indices
273
274    IMPLICIT NONE
275
276    CHARACTER (LEN=30) ::  atext
277    INTEGER            ::  i, j, k, m, pr
278    LOGICAL            ::  frame_written
279    REAL               ::  frequency = 0.0
280
281!
282!-- Variables needed for PROFIL-namelist
283    INTEGER                  :: cranz, labforx = 3, labfory = 3, legpos = 3, &
284                                timodex = 1
[189]285    INTEGER, DIMENSION(1:100):: cucol = 1, klist = 999999, lstyle = 0
[1]286    LOGICAL                  :: datleg = .TRUE., grid = .TRUE., &
287                                lclose = .TRUE., rand = .TRUE., &
288                                swap = .TRUE., twoxa = .TRUE.,  &
289                                xlog = .TRUE., ylog = .TRUE.
290    CHARACTER (LEN=80)       :: rtext, utext, xtext = 'k in m>->1', ytext
291    REAL                     :: gwid = 0.1, rlegfak = 0.7, uxmin, uxmax, &
292                                uymin, uymax
[189]293    REAL, DIMENSION(1:100)   :: lwid = 0.6
294    REAL, DIMENSION(100)     :: uyma, uymi
[1]295
296    NAMELIST /RAHMEN/  cranz, datleg, rtext, swap
297    NAMELIST /CROSS/   rand, cucol, grid, gwid, klist, labforx, labfory,      &
298                       legpos, lclose, lstyle, lwid, rlegfak, timodex, utext, &
299                       uxmin, uxmax, uymin, uymax, twoxa, xlog, xtext, ylog,  &
300                       ytext
301
302
303    rtext = '\0.5 ' // run_description_header
304
305!
306!-- Open parameter- and data-file
307    CALL check_open( 81 )
308    CALL check_open( 82 )
309
310!
311!-- Write file header,
312!-- write RAHMEN-parameters (pr=3: w-array is on zw, other arrys on zu,
313!-- pr serves as an index for output of strings (axis-labels) of the
314!-- different quantities u, v, w, pt and q)
315    DO  k = 1, n_sp_x
[189]316       IF ( k < 100 )  THEN
[1]317          IF ( pr == 3 )  THEN
318             WRITE ( 82, 100 )  '#', k, header_char( pr ),        &
319                                INT( zw(comp_spectra_level(k)) ), &
320                                simulated_time_chr
321          ELSE
322             WRITE ( 82, 100 )  '#', k, header_char( pr ),        &
323                                INT( zu(comp_spectra_level(k)) ), &
324                                simulated_time_chr
325          ENDIF
326       ELSE
327          IF ( pr == 3 )  THEN
328             WRITE ( 82, 101 )  '#', k, header_char( pr ),        &
329                                INT( zw(comp_spectra_level(k)) ), &
330                                simulated_time_chr
331          ELSE
332             WRITE ( 82, 101 )  '#', k, header_char( pr ),        &
333                                INT( zu(comp_spectra_level(k)) ), &
334                                simulated_time_chr
335          ENDIF
336       ENDIF
337    ENDDO
338
339    IF ( .NOT. frame_written )  THEN
340       WRITE ( 81, RAHMEN )
341       frame_written = .TRUE.
342    ENDIF
343
344!
345!-- Write all data and calculate uymi and uyma. They serve to calculate
346!-- the CROSS-parameters uymin and uymax
347    uymi = 999.999; uyma = -999.999
348    DO  i = 1, nx/2
349       frequency = 2.0 * pi * i / ( dx * ( nx + 1 ) )
350       WRITE ( 82, 102 )  frequency, ( frequency * spectrum_x(i,k,m), k = 1, &
351                          n_sp_x )
352       DO  k = 1, n_sp_x
353          uymi(k) = MIN( uymi(k), frequency * spectrum_x(i,k,m) )
354          uyma(k) = MAX( uyma(k), frequency * spectrum_x(i,k,m) )
355       ENDDO
356    ENDDO
357
358!
359!-- Determine CROSS-parameters
360    cucol(1:n_sp_x)  = (/ ( k, k = 1, n_sp_x ) /)
361    lstyle(1:n_sp_x) = (/ ( lstyles(k), k = 1, n_sp_x ) /)
362
363!
364!-- Calculate klist-values from the available comp_spectra_level values
365    i = 1; k = 1
[189]366    DO WHILE ( i <= 100  .AND.  plot_spectra_level(i) /= 999999 )
[1]367       DO WHILE ( k <= n_sp_x  .AND. &
368                  plot_spectra_level(i) >= comp_spectra_level(k) )
369          IF ( plot_spectra_level(i) == comp_spectra_level(k) )  THEN
370             klist(i) = k + klist_x
371          ELSE
372             uymi(k) =  999.999
373             uyma(k) = -999.999
374          ENDIF
375          k = k + 1
376       ENDDO
377       i = i + 1
378    ENDDO
379    uymi(k:n_sp_x) =  999.999
380    uyma(k:n_sp_x) = -999.999
381    utext = 'x'//utext_char( pr )
382    IF ( averaging_interval_sp /= 0.0 ) THEN
383       WRITE ( atext, 104 )  averaging_interval_sp
384       utext = TRIM(utext) // ',  ' // TRIM( atext )
385    ENDIF
386    uxmin = 0.8 * 2.0 * pi        / ( dx * ( nx + 1 ) )
387    uxmax = 1.2 * 2.0 * pi * nx/2 / ( dx * ( nx + 1 ) )
388    uymin = 0.8 * MIN (  999.999, MINVAL ( uymi ) )
389    uymax = 1.2 * MAX ( -999.999, MAXVAL ( uyma ) )
390    ytext = ytext_char( pr )
391
392!
393!-- Output of CROSS-parameters
394    WRITE ( 81, CROSS )
395
396!
397!-- Increase counter by the number of profiles written in the actual block
398    klist_x = klist_x + n_sp_x
399
400!
401!-- Write end-mark
402    WRITE ( 82, 103 )
403
404!
405!-- Close parameter- and data-file
406    CALL close_file( 81 )
407    CALL close_file( 82 )
408
409!
410!-- Formats
411100 FORMAT (A,I1,1X,A,1X,I4,'m ',A)
412101 FORMAT (A,I2,1X,A,1X,I4,'m ',A)
[189]413102 FORMAT (E15.7,100(1X,E15.7))
[1]414103 FORMAT ('NEXT')
415104 FORMAT ('time averaged over',F7.1,' s')
416
417 END SUBROUTINE data_output_spectra_x
418
419
420 SUBROUTINE data_output_spectra_y( m, cranz, pr, frame_written )
421
422    USE arrays_3d
423    USE constants
424    USE control_parameters
425    USE grid_variables
426    USE indices
427    USE pegrid
428    USE singleton
429    USE spectrum
430    USE statistics
431    USE transpose_indices
432
433    IMPLICIT NONE
434
435    CHARACTER (LEN=30) ::  atext
436    INTEGER            :: i, j, k, m, pr
437    LOGICAL            :: frame_written
438    REAL               :: frequency = 0.0
439
440!
441!-- Variables needed for PROFIL-namelist
442    INTEGER                  :: cranz, labforx = 3, labfory = 3, legpos = 3, &
443                                timodex = 1
[189]444    INTEGER, DIMENSION(1:100):: cucol = 1, klist = 999999, lstyle = 0
[1]445    LOGICAL                  :: datleg = .TRUE., grid = .TRUE., &
446                                lclose = .TRUE., rand = .TRUE., &
447                                swap = .TRUE., twoxa = .TRUE.,  &
448                                xlog = .TRUE., ylog = .TRUE.
449    CHARACTER (LEN=80)       :: rtext, utext, xtext = 'k in m>->1', ytext
450    REAL                     :: gwid = 0.1, rlegfak = 0.7, uxmin, uxmax, &
451                                uymin, uymax
[189]452    REAL, DIMENSION(1:100)   :: lwid = 0.6
453    REAL, DIMENSION(100)     :: uyma, uymi
[1]454
455    NAMELIST /RAHMEN/  cranz, datleg, rtext, swap
456    NAMELIST /CROSS/   rand, cucol, grid, gwid, klist, labforx, labfory,      &
457                       legpos, lclose, lstyle, lwid, rlegfak, timodex, utext, &
458                       uxmin, uxmax, uymin, uymax, twoxa, xlog, xtext, ylog,  &
459                       ytext
460
461
462    rtext = '\0.5 ' // run_description_header
463
464!
465!-- Open parameter- and data-file
466    CALL check_open( 83 )
467    CALL check_open( 84 )
468
469!
470!-- Write file header,
471!-- write RAHMEN-parameters (pr=3: w-array is on zw, other arrys on zu,
472!-- pr serves as an index for output of strings (axis-labels) of the
473!-- different quantities u, v, w, pt and q)
474    DO  k = 1, n_sp_y
[189]475       IF ( k < 100 )  THEN
[1]476          IF ( pr == 3 ) THEN
477             WRITE ( 84, 100 )  '#', k, header_char( pr ),        &
478                                INT( zw(comp_spectra_level(k)) ), &
479                                simulated_time_chr
480          ELSE
481             WRITE ( 84, 100 )  '#', k, header_char( pr ),        &
482                                INT( zu(comp_spectra_level(k)) ), &
483                                simulated_time_chr
484          ENDIF
485       ELSE
486          IF ( pr == 3 )  THEN
487             WRITE ( 84, 101 )  '#', k, header_char( pr ),        &
488                                INT( zw(comp_spectra_level(k)) ), &
489                                simulated_time_chr
490          ELSE
491             WRITE ( 84, 101 )  '#', k, header_char( pr ),        &
492                                INT( zu(comp_spectra_level(k)) ), &
493                                simulated_time_chr
494          ENDIF
495       ENDIF
496    ENDDO
497
498    IF ( .NOT. frame_written )  THEN
499       WRITE ( 83, RAHMEN )
500       frame_written = .TRUE.
501    ENDIF
502
503!
504!-- Write all data and calculate uymi and uyma. They serve to calculate
505!-- the CROSS-parameters uymin and uymax
506    uymi = 999.999; uyma = -999.999
507    DO  j = 1, ny/2
508       frequency = 2.0 * pi * j / ( dy * ( ny + 1 ) )
509       WRITE ( 84, 102 ) frequency, ( frequency * spectrum_y(j,k,m), &
510                                      k = 1, n_sp_y ) 
511       DO k = 1, n_sp_y
512          uymi(k) = MIN( uymi(k), frequency * spectrum_y(j,k,m) )
513          uyma(k) = MAX( uyma(k), frequency * spectrum_y(j,k,m) )
514       ENDDO
515    ENDDO
516
517!
518!-- Determine CROSS-parameters
519    cucol(1:n_sp_y)  = (/ ( k, k = 1, n_sp_y ) /)
520    lstyle(1:n_sp_y) = (/ ( lstyles(k), k = 1, n_sp_y ) /)
521
522!
523!-- Calculate klist-values from the available comp_spectra_level values
524    j = 1; k = 1
[189]525    DO WHILE ( j <= 100  .AND.  plot_spectra_level(j) /= 999999 )
[1]526       DO WHILE ( k <= n_sp_y  .AND. &
527                  plot_spectra_level(j) >= comp_spectra_level(k) )
528          IF ( plot_spectra_level(j) == comp_spectra_level(k) )  THEN
529             klist(j) = k + klist_y
530          ELSE
531             uymi(k) =  999.999
532             uyma(k) = -999.999
533          ENDIF
534          k = k + 1
535       ENDDO
536       j = j + 1
537    ENDDO
538    uymi(k:n_sp_y) =  999.999
539    uyma(k:n_sp_y) = -999.999
540    utext = 'y'//utext_char( pr )
541    IF ( averaging_interval_sp /= 0.0 )  THEN
542       WRITE ( atext, 104 )  averaging_interval_sp
543       utext = TRIM(utext) // ',  ' // TRIM( atext )
544    ENDIF
545    uxmin = 0.8 * 2.0 * pi        / ( dy * ( ny + 1 ) )
546    uxmax = 1.2 * 2.0 * pi * ny/2 / ( dy * ( ny + 1 ) )
547    uymin = 0.8 * MIN (  999.999, MINVAL ( uymi ) )
548    uymax = 1.2 * MAX ( -999.999, MAXVAL ( uyma ) )
549    ytext = ytext_char( pr )
550
551!
552!-- Output CROSS-parameters
553    WRITE ( 83, CROSS )
554
555!
556!-- Increase counter by the number of profiles written in the actual block
557    klist_y = klist_y + n_sp_y
558
559!
560!-- Write end-mark
561    WRITE ( 84, 103 ) 
562
563!
564!-- Close parameter- and data-file
565    CALL close_file( 83 )
566    CALL close_file( 84 )
567
568!
569!-- Formats
570100 FORMAT (A,I1,1X,A,1X,I4,'m ',A)
571101 FORMAT (A,I2,1X,A,1X,I4,'m ',A)
[189]572102 FORMAT (E15.7,100(1X,E15.7))
[1]573103 FORMAT ('NEXT')
574104 FORMAT ('time averaged over',F7.1,' s')
575
576 END SUBROUTINE data_output_spectra_y
577#endif
Note: See TracBrowser for help on using the repository browser.