Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |