Home

Context Navigation

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

Last change on this file since 1765 was 1683, checked in by knoop, 9 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 21.8 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |