Home

Context Navigation

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

Last change on this file since 844 was 565, checked in by helmke, 14 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 20.7 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |