Home

Context Navigation

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

Last change on this file since 415 was 410, checked in by letzel, 15 years ago
reintegrate branch letzel/masked_output into trunk; new funtionality: masked data output (not yet documented)
Property svn:keywords set to `Id`
File size: 20.4 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |