Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |