Home

Context Navigation

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

Last change on this file since 1326 was 1325, checked in by suehring, 11 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 20.8 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |