Home

Context Navigation

source: palm/trunk/SOURCE/close_file.f90 @ 324

Last change on this file since 324 was 263, checked in by heinze, 16 years ago
Output of NetCDF messages with aid of message handling routine.
Property svn:keywords set to `Id`
File size: 19.3 KB

Rev	Line
[1]	1	SUBROUTINE close_file( file_id )
	2
	3	!------------------------------------------------------------------------------!
[263]	4	! Current revisions:
[1]	5	! -----------------
[263]	6	! Output of NetCDF messages with aid of message handling routine.
[1]	7	!
	8	! Former revisions:
	9	! -----------------
[3]	10	! $Id: close_file.f90 263 2009-03-18 12:26:04Z weinreis $
	11	! RCS Log replace by Id keyword, revision history cleaned up
	12	!
[1]	13	! Revision 1.10 2006/08/22 13:50:01 raasch
	14	! xz and yz cross sections now up to nzt+1
	15	!
	16	! Revision 1.1 2001/01/02 17:23:41 raasch
	17	! Initial revision
	18	!
	19	! Last revision before renaming subroutine 2001/01/01 raasch
	20	! Subroutine name changed from close_files to close_file. Closing of a single
	21	! file is allowed by passing its file-id as an argument. Variable openfile now
	22	! is of type file_status and contains a flag which indicates if a file has
	23	! been opened before. Old revision remarks deleted.
	24	!
	25	! Revision 1.13 (close_files) 2000/12/20 09:10:24 letzel
	26	! All comments translated into English.
	27	!
	28	! Revision 1.12 (close_files) 1999/03/02 09:22:46 raasch
	29	! FLD-Header fuer komprimierte 3D-Daten
	30	!
	31	! Revision 1.1 (close_files) 1997/08/11 06:11:18 raasch
	32	! Initial revision
	33	!
	34	!
	35	! Description:
	36	! ------------
	37	! Close specified file or all open files, if "0" has been given as the
	38	! calling argument. In that case, execute last actions for certain unit
	39	! numbers, if required.
	40	!------------------------------------------------------------------------------!
	41
	42	USE control_parameters
	43	USE grid_variables
	44	USE indices
	45	USE netcdf_control
	46	USE pegrid
	47	USE profil_parameter
	48	USE statistics
	49
	50	IMPLICIT NONE
	51
	52	CHARACTER (LEN=2) :: suffix
	53	CHARACTER (LEN=10) :: datform = 'lit_endian'
	54	CHARACTER (LEN=80) :: rtext, title, utext = '', xtext = '', ytext = ''
	55
	56	INTEGER :: anzzeile, cranz, cross_count, cross_numbers, dimx, dimy, &
	57	fid, file_id, j, k, legpos = 1, planz, timodex = 1
	58	INTEGER, DIMENSION(100) :: klist, lstyle, cucol
	59
	60	LOGICAL :: checkuf = .TRUE., datleg = .TRUE., dp = .FALSE., &
	61	grid = .TRUE., rand = .TRUE., swap, twoxa = .TRUE., &
	62	twoya = .TRUE.
	63
	64	REAL :: ansx = -999.999, ansy = -999.999, gwid = 0.1, rlegfak, &
	65	sizex, sizey, texfac, utmove = 50.0, uxmax, uxmin, uymax, &
	66	uymin, yright
	67	REAL, DIMENSION(100) :: lwid, normx, normy
	68
	69	NAMELIST /CROSS/ ansx, ansy, cucol, grid, gwid, klist, legpos, lstyle, &
	70	lwid, normx, normy, rand, rlegfak, sizex, sizey, &
	71	texfac, timodex, twoxa, twoya, utext, utmove, uxmax, &
	72	uxmin, uymax, uymin, xtext, ytext
	73	NAMELIST /GLOBAL/ checkuf, datform, dimx, dimy, dp, planz, sizex, sizey, &
	74	title, yright
	75	NAMELIST /RAHMEN/ anzzeile, cranz, datleg, rtext, swap
	76
	77	!
	78	!-- Close specified unit number (if opened) and set a flag that it has
	79	!-- been opened one time at least
	80	IF ( file_id /= 0 ) THEN
	81	IF ( openfile(file_id)%opened ) THEN
	82	CLOSE ( file_id )
	83	openfile(file_id)%opened = .FALSE.
	84	openfile(file_id)%opened_before = .TRUE.
	85	ENDIF
	86	RETURN
	87	ENDIF
	88
	89	!
	90	!-- Close all open unit numbers
	91	DO fid = 1, 116
	92
	93	IF ( openfile(fid)%opened .OR. openfile(fid)%opened_before ) THEN
	94	!
	95	!-- Last actions for certain unit numbers
	96	SELECT CASE ( fid )
	97
	98	CASE ( 21 )
	99	!
	100	!-- Write ISO2D global parameters
	101	IF ( myid == 0 .AND. iso2d_output ) THEN
	102	planz = do2d_xy_n
	103	dimx = nx + 2
	104	dimy = ny + 2
	105	sizex = 100.0
	106	sizey = 100.0
	107	title = run_description_header
	108	yright = ( ny + 1.0 ) * dy
	109	IF ( host(1:3) == 'ibm' .OR. host(1:3) == 't3e' ) THEN
	110	checkuf = .FALSE.; dp = .TRUE.
	111	ENDIF
	112	IF ( host(1:3) == 'ibm' .OR. host(1:3) == 'nec' ) THEN
	113	datform = 'big_endian'
	114	ENDIF
	115	OPEN ( 90, FILE='PLOT2D_XY_GLOBAL', FORM='FORMATTED', &
	116	DELIM='APOSTROPHE' )
	117	WRITE ( 90, GLOBAL )
	118	CLOSE ( 90 )
	119	ENDIF
	120
	121	CASE ( 22 )
	122	!
	123	!-- Write ISO2D global parameters
	124	IF ( myid == 0 ) THEN
	125	planz = do2d_xz_n
	126	dimx = nx + 2
	127	dimy = nz + 2
	128	sizex = 100.0
	129	sizey = 65.0
	130	title = run_description_header
	131	yright = z_max_do2d
	132	IF ( host(1:3) == 'ibm' .OR. host(1:3) == 't3e' ) THEN
	133	checkuf = .FALSE.; dp = .TRUE.
	134	ENDIF
	135	IF ( host(1:3) == 'ibm' .OR. host(1:3) == 'nec' ) THEN
	136	datform = 'big_endian'
	137	ENDIF
	138	OPEN ( 90, FILE='PLOT2D_XZ_GLOBAL', FORM='FORMATTED', &
	139	DELIM='APOSTROPHE' )
	140	WRITE ( 90, GLOBAL )
	141	CLOSE ( 90 )
	142	ENDIF
	143
	144	CASE ( 23 )
	145	!
	146	!-- Write ISO2D global parameters
	147	IF ( myid == 0 ) THEN
	148	planz = do2d_yz_n
	149	dimx = ny + 2
	150	dimy = nz + 2
	151	sizex = 100.0
	152	sizey = 65.0
	153	title = run_description_header
	154	yright = z_max_do2d
	155	IF ( host(1:3) == 'ibm' .OR. host(1:3) == 't3e' ) THEN
	156	checkuf = .FALSE.; dp = .TRUE.
	157	ENDIF
	158	IF ( host(1:3) == 'ibm' .OR. host(1:3) == 'nec' ) THEN
	159	datform = 'big_endian'
	160	ENDIF
	161	OPEN ( 90, FILE='PLOT2D_YZ_GLOBAL', FORM='FORMATTED', &
	162	DELIM='APOSTROPHE' )
	163	WRITE ( 90, GLOBAL )
	164	CLOSE ( 90 )
	165	ENDIF
	166
	167	CASE ( 32 )
	168	!
	169	!-- Write header for FLD-file
	170	IF ( do3d_compress ) THEN
	171	WRITE ( 32, 3200) ' compressed ', &
	172	TRIM( run_description_header ), nx+2, &
	173	ny+2, nz_do3d+1, do3d_avs_n
	174	ELSE
	175	WRITE ( 32, 3200) ' ', TRIM( run_description_header ), &
	176	nx+2, ny+2, nz_do3d+1, do3d_avs_n
	177	ENDIF
	178
	179	CASE ( 40:49 )
	180	!
	181	!-- Write PROFIL namelist parameters for 1D profiles.
	182	!-- First determine, how many crosses are to be drawn.
	183	IF ( myid == 0 ) THEN
	184	cross_numbers = 0
	185	DO j = 1, crmax
	186	IF ( cross_profile_number_count(j) /= 0 ) THEN
	187	cross_numbers = cross_numbers + 1
	188	ENDIF
	189	ENDDO
	190
	191	IF ( cross_numbers /= 0 ) THEN
	192	!
	193	!-- Determine remaining RAHMEN parameters
	194	swap = .FALSE.
	195	rtext = '\0.5 ' // TRIM( run_description_header ) // &
	196	' ' // TRIM( region( fid - 40 ) )
	197	!
	198	!-- Write RAHMEN parameters
	199	IF ( statistic_regions == 0 .AND. fid == 40 ) THEN
	200	suffix = ''
	201	ELSE
	202	WRITE ( suffix, '(''_'',I1)' ) fid - 40
	203	ENDIF
	204	OPEN ( 90, FILE='PLOT1D_PAR' // TRIM( suffix ), &
	205	FORM='FORMATTED', DELIM='APOSTROPHE' )
	206	!
	207	!-- Subtitle for crosses with time averaging
	208	IF ( averaging_interval_pr /= 0.0 ) THEN
	209	WRITE ( utext, 4000 ) averaging_interval_pr
	210	ENDIF
	211	!
	212	!-- Determine and write CROSS parameters for each individual
	213	!-- cross
	214	cross_count = 0
	215	DO j = 1, crmax
	216	k = cross_profile_number_count(j)
	217	IF ( k /= 0 ) THEN
	218	cross_count = cross_count + 1
	219	!
	220	!-- Write RAHMEN parameters
	221	IF ( MOD( cross_count-1, &
	222	profile_rows*profile_columns ) == 0 ) &
	223	THEN
	224	!
	225	!-- Determine number of crosses still to be drawn
	226	cranz = MIN( cross_numbers - cross_count + 1, &
	227	profile_rows * profile_columns )
	228	!
	229	!-- If the first line cannot be filled with crosses
	230	!-- completely, the default number of crosses per
	231	!-- line has to be reduced.
	232	IF ( cranz < profile_columns ) THEN
	233	anzzeile = cranz
	234	ELSE
	235	anzzeile = profile_columns
	236	ENDIF
	237
	238	WRITE ( 90, RAHMEN )
	239
	240	ENDIF
	241	!
	242	!-- Store graph numbers
	243	klist(1:k) = cross_profile_numbers(1:k,j)
	244	klist(k+1:100) = 999999
	245	!
	246	!-- Store graph attributes
	247	cucol = cross_linecolors(:,j)
	248	lstyle = cross_linestyles(:,j)
	249	lwid = 0.6
	250	!
	251	!-- Sizes, text etc.
	252	sizex = 100.0; sizey = 120.0
	253	rlegfak = 0.7; texfac = 1.0
	254	!
	255	!-- Determine range of x-axis values
	256	IF ( cross_normalized_x(j) == ' ' ) THEN
	257	!
	258	!-- Non-normalized profiles
	259	IF ( cross_uxmin(j) == 0.0 .AND. &
	260	cross_uxmax(j) == 0.0 ) THEN
	261	uxmin = cross_uxmin_computed(j)
	262	uxmax = cross_uxmax_computed(j)
	263	IF ( uxmin == uxmax ) uxmax = uxmin + 1.0
	264	ELSE
	265	!
	266	!-- Values set in check_parameters are used here
	267	uxmin = cross_uxmin(j); uxmax = cross_uxmax(j)
	268	ENDIF
	269	ELSE
	270	!
	271	!-- Normalized profiles
	272	IF ( cross_uxmin_normalized(j) == 0.0 .AND. &
	273	cross_uxmax_normalized(j) == 0.0 ) THEN
	274	uxmin = cross_uxmin_normalized_computed(j)
	275	uxmax = cross_uxmax_normalized_computed(j)
	276	IF ( uxmin == uxmax ) uxmax = uxmin + 1.0
	277	ELSE
	278	!
	279	!-- Values set in check_parameters are used here
	280	uxmin = cross_uxmin_normalized(j)
	281	uxmax = cross_uxmax_normalized(j)
	282	ENDIF
	283	ENDIF
	284	!
	285	!-- Range of y-axis values
	286	!-- may be re-adjusted during normalization if required
	287	uymin = cross_uymin(j); uymax = cross_uymax(j)
	288	ytext = 'height in m'
	289	!
	290	!-- Normalization of the axes
	291	normx = cross_normx_factor(:,j)
	292	normy = cross_normy_factor(:,j)
	293	!
	294	!-- Labelling of the axes
	295	IF ( cross_normalized_x(j) == ' ' ) THEN
	296	xtext = cross_xtext(j)
	297	ELSE
	298	xtext = TRIM( cross_xtext(j) ) // ' / ' // &
	299	cross_normalized_x(j)
	300	ENDIF
	301	IF ( cross_normalized_y(j) == ' ' ) THEN
	302	ytext = 'height in m'
	303	ELSE
	304	ytext = 'height in m' // ' / ' // &
	305	cross_normalized_y(j)
	306	!
	307	!-- Determine upper limit of value range
	308	IF ( z_max_do1d_normalized /= -1.0 ) THEN
	309	uymax = z_max_do1d_normalized
	310	ENDIF
	311	ENDIF
	312
	313	WRITE ( 90, CROSS )
	314
	315	ENDIF
	316	ENDDO
	317
	318	CLOSE ( 90 )
	319	ENDIF
	320	ENDIF
	321
	322	CASE ( 50:59 )
	323	!
	324	!-- Write PROFIL namelist parameters for time series
	325	!-- first determine number of crosses to be drawn
	326	IF ( myid == 0 ) THEN
	327	cranz = 0
	328	DO j = 1, 12
	329	IF ( cross_ts_number_count(j) /= 0 ) cranz = cranz+1
	330	ENDDO
	331
	332	IF ( cranz /= 0 ) THEN
	333	!
	334	!-- Determine RAHMEN parameters
	335	anzzeile = 1
	336	swap = .TRUE.
	337	rtext = '\1.0 ' // TRIM( run_description_header ) // &
	338	' ' // TRIM( region( fid - 50 ) )
	339	!
	340	!-- Write RAHMEN parameters
	341	IF ( statistic_regions == 0 .AND. fid == 50 ) THEN
	342	suffix = ''
	343	ELSE
	344	WRITE ( suffix, '(''_'',I1)' ) fid - 50
	345	ENDIF
	346	OPEN ( 90, FILE='PLOTTS_PAR' // TRIM( suffix ), &
	347	FORM='FORMATTED', DELIM='APOSTROPHE' )
	348	WRITE ( 90, RAHMEN )
	349	!
	350	!-- Determine and write CROSS parameters for each individual
	351	!-- cross
	352	DO j = 1, 12
	353	k = cross_ts_number_count(j)
	354	IF ( k /= 0 ) THEN
	355	!
	356	!-- Store graph numbers
	357	klist(1:k) = cross_ts_numbers(1:k,j)
	358	klist(k+1:100) = 999999
	359	!
	360	!-- Store graph attributes
	361	cucol(1:k) = linecolors(1:k)
	362	lstyle(1:k) = linestyles(1:k)
	363	lwid = 0.4
	364	!
	365	!-- Sizes, text etc.
	366	sizex = 250.0; sizey = 40.0
	367	rlegfak = 1.5; texfac = 1.5
	368	xtext = 'time in s'
	369	ytext = ''
	370	utext = ''
	371	!
	372	!-- Determine range of y-axis values
	373	IF ( cross_ts_uymin(j) == 999.999 ) THEN
	374	uymin = cross_ts_uymin_computed(j)
	375	ELSE
	376	uymin = cross_ts_uymin(j)
	377	ENDIF
	378	IF ( cross_ts_uymax(j) == 999.999 ) THEN
	379	uymax = cross_ts_uymax_computed(j)
	380	ELSE
	381	uymax = cross_ts_uymax(j)
	382	ENDIF
	383	IF ( uymin == uymax ) uymax = uymin + 1.0
	384	!
	385	!-- Range of x-axis values
	386	uxmin = 0.0; uxmax = simulated_time
	387	!
	388	!-- Normalizations
	389	normx = 1.0; normy = 1.0
	390
	391	WRITE ( 90, CROSS )
	392
	393	ENDIF
	394	ENDDO
	395
	396	CLOSE ( 90 )
	397	ENDIF
	398	ENDIF
	399
	400	#if defined( __netcdf )
	401	CASE ( 101 )
	402
	403	IF ( myid == 0 .AND. netcdf_output ) THEN
	404	nc_stat = NF90_CLOSE( id_set_xy(0) )
[263]	405	CALL handle_netcdf_error( 'close_file', 44 )
[1]	406	ENDIF
	407
	408	CASE ( 102 )
	409
	410	IF ( myid == 0 .AND. netcdf_output ) THEN
	411	nc_stat = NF90_CLOSE( id_set_xz(0) )
[263]	412	CALL handle_netcdf_error( 'close_file', 45 )
[1]	413	ENDIF
	414
	415	CASE ( 103 )
	416
	417	IF ( myid == 0 .AND. netcdf_output ) THEN
	418	nc_stat = NF90_CLOSE( id_set_yz(0) )
[263]	419	CALL handle_netcdf_error( 'close_file', 46 )
[1]	420	ENDIF
	421
	422	CASE ( 104 )
	423
	424	IF ( myid == 0 .AND. netcdf_output ) THEN
	425	nc_stat = NF90_CLOSE( id_set_pr )
[263]	426	CALL handle_netcdf_error( 'close_file', 47 )
[1]	427	ENDIF
	428
	429	CASE ( 105 )
	430
	431	IF ( myid == 0 .AND. netcdf_output ) THEN
	432	nc_stat = NF90_CLOSE( id_set_ts )
[263]	433	CALL handle_netcdf_error( 'close_file', 48 )
[1]	434	ENDIF
	435
	436	CASE ( 106 )
	437
	438	IF ( myid == 0 .AND. netcdf_output ) THEN
	439	nc_stat = NF90_CLOSE( id_set_3d(0) )
[263]	440	CALL handle_netcdf_error( 'close_file', 49 )
[1]	441	ENDIF
	442
	443	CASE ( 107 )
	444
	445	IF ( myid == 0 .AND. netcdf_output ) THEN
	446	nc_stat = NF90_CLOSE( id_set_sp )
[263]	447	CALL handle_netcdf_error( 'close_file', 50 )
[1]	448	ENDIF
	449
	450	CASE ( 108 )
	451
	452	IF ( netcdf_output ) THEN
	453	nc_stat = NF90_CLOSE( id_set_prt )
[263]	454	CALL handle_netcdf_error( 'close_file', 51 )
[1]	455	ENDIF
	456
	457	CASE ( 109 )
	458
	459	IF ( netcdf_output ) THEN
	460	nc_stat = NF90_CLOSE( id_set_pts )
[263]	461	CALL handle_netcdf_error( 'close_file', 412 )
[1]	462	ENDIF
	463
	464	CASE ( 111 )
	465
	466	IF ( myid == 0 .AND. netcdf_output ) THEN
	467	nc_stat = NF90_CLOSE( id_set_xy(1) )
[263]	468	CALL handle_netcdf_error( 'close_file', 52 )
[1]	469	ENDIF
	470
	471	CASE ( 112 )
	472
	473	IF ( myid == 0 .AND. netcdf_output ) THEN
	474	nc_stat = NF90_CLOSE( id_set_xz(1) )
[263]	475	CALL handle_netcdf_error( 'close_file', 352 )
[1]	476	ENDIF
	477
	478	CASE ( 113 )
	479
	480	IF ( myid == 0 .AND. netcdf_output ) THEN
	481	nc_stat = NF90_CLOSE( id_set_yz(1) )
[263]	482	CALL handle_netcdf_error( 'close_file', 353 )
[1]	483	ENDIF
	484
	485	CASE ( 116 )
	486
	487	IF ( myid == 0 .AND. netcdf_output ) THEN
	488	nc_stat = NF90_CLOSE( id_set_3d(1) )
[263]	489	CALL handle_netcdf_error( 'close_file', 353 )
[1]	490	ENDIF
	491
	492	#endif
	493
	494	END SELECT
	495	!
	496	!-- Close file
	497	IF ( openfile(fid)%opened ) CLOSE ( fid )
	498
	499	ENDIF
	500
	501	ENDDO
	502
	503	!
	504	!-- Formats
	505	3200 FORMAT ('# AVS',A,'field file'/ &
	506	'#'/ &
	507	'# ',A/ &
	508	'ndim=3'/ &
	509	'dim1=',I5/ &
	510	'dim2=',I5/ &
	511	'dim3=',I5/ &
	512	'nspace=3'/ &
	513	'veclen=',I5/ &
	514	'data=xdr_float'/ &
	515	'field=rectilinear')
	516	4000 FORMAT ('time averaged over',F7.1,' s')
	517
	518
	519	END SUBROUTINE close_file

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |