Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |