Home

Context Navigation

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

Last change on this file since 486 was 449, checked in by raasch, 15 years ago
branch revision comments from Marcus (rev 410) replaced by normal revision comments
Property svn:keywords set to `Id`
File size: 20.3 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |