Home

Context Navigation

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

Last change on this file since 554 was 494, checked in by raasch, 15 years ago
last commit documented; configuration example file for netcdf4 added
Property svn:keywords set to `Id`
File size: 20.5 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |