Home

Context Navigation

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

Last change on this file since 974 was 965, checked in by raasch, 12 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 10.7 KB

Rev	Line
[1]	1	SUBROUTINE close_file( file_id )
	2
	3	!------------------------------------------------------------------------------!
[263]	4	! Current revisions:
[1]	5	! -----------------
	6	!
[965]	7	!
[1]	8	! Former revisions:
	9	! -----------------
[3]	10	! $Id: close_file.f90 965 2012-07-26 09:29:52Z maronga $
[392]	11	!
[965]	12	! 964 2012-07-26 09:14:24Z raasch
	13	! old profil-units (40:49) and respective code removed
	14	!
[565]	15	! 564 2010-09-30 13:18:59Z helmke
	16	! start number of mask output files changed to 201, netcdf message identifiers
	17	! of masked output changed
	18	!
[494]	19	! 493 2010-03-01 08:30:24Z raasch
	20	! Adjustments for NetCDF parallel data output
	21	!
[449]	22	! 410 2009-12-04 17:05:40Z letzel
	23	! masked data output
	24	!
[392]	25	! 263 2009-03-18 12:26:04Z heinze
	26	! Output of NetCDF messages with aid of message handling routine.
	27	!
	28	! Feb. 2007
[3]	29	! RCS Log replace by Id keyword, revision history cleaned up
	30	!
[1]	31	! Revision 1.10 2006/08/22 13:50:01 raasch
	32	! xz and yz cross sections now up to nzt+1
	33	!
	34	! Revision 1.1 2001/01/02 17:23:41 raasch
	35	! Initial revision
	36	!
	37	! Last revision before renaming subroutine 2001/01/01 raasch
	38	! Subroutine name changed from close_files to close_file. Closing of a single
	39	! file is allowed by passing its file-id as an argument. Variable openfile now
	40	! is of type file_status and contains a flag which indicates if a file has
	41	! been opened before. Old revision remarks deleted.
	42	!
	43	! Revision 1.13 (close_files) 2000/12/20 09:10:24 letzel
	44	! All comments translated into English.
	45	!
	46	! Revision 1.12 (close_files) 1999/03/02 09:22:46 raasch
	47	! FLD-Header fuer komprimierte 3D-Daten
	48	!
	49	! Revision 1.1 (close_files) 1997/08/11 06:11:18 raasch
	50	! Initial revision
	51	!
	52	!
	53	! Description:
	54	! ------------
	55	! Close specified file or all open files, if "0" has been given as the
	56	! calling argument. In that case, execute last actions for certain unit
	57	! numbers, if required.
	58	!------------------------------------------------------------------------------!
	59
	60	USE control_parameters
	61	USE grid_variables
	62	USE indices
	63	USE netcdf_control
	64	USE pegrid
	65	USE profil_parameter
	66	USE statistics
	67
	68	IMPLICIT NONE
	69
	70	CHARACTER (LEN=2) :: suffix
	71	CHARACTER (LEN=10) :: datform = 'lit_endian'
[964]	72	CHARACTER (LEN=80) :: rtext, title
[1]	73
[964]	74	INTEGER :: av, anzzeile, dimx, dimy, &
	75	fid, file_id, j, k, planz
[1]	76
[964]	77	LOGICAL :: checkuf = .TRUE., datleg = .TRUE., dp = .FALSE., swap
[1]	78
[964]	79	REAL :: sizex, sizey, yright
[1]	80
[964]	81	NAMELIST /GLOBAL/ checkuf, datform, dimx, dimy, dp, planz, &
	82	title
	83	NAMELIST /RAHMEN/ anzzeile, datleg, rtext, swap
[1]	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
[564]	99	DO fid = 1, 200+2*max_masks
[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	#if defined( __netcdf )
	188	CASE ( 101 )
	189
[493]	190	IF ( netcdf_output .AND. &
	191	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
[1]	192	nc_stat = NF90_CLOSE( id_set_xy(0) )
[263]	193	CALL handle_netcdf_error( 'close_file', 44 )
[1]	194	ENDIF
	195
	196	CASE ( 102 )
	197
[493]	198	IF ( netcdf_output .AND. &
	199	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
[1]	200	nc_stat = NF90_CLOSE( id_set_xz(0) )
[263]	201	CALL handle_netcdf_error( 'close_file', 45 )
[1]	202	ENDIF
	203
	204	CASE ( 103 )
	205
[493]	206	IF ( netcdf_output .AND. &
	207	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
[1]	208	nc_stat = NF90_CLOSE( id_set_yz(0) )
[263]	209	CALL handle_netcdf_error( 'close_file', 46 )
[1]	210	ENDIF
	211
	212	CASE ( 104 )
	213
	214	IF ( myid == 0 .AND. netcdf_output ) THEN
	215	nc_stat = NF90_CLOSE( id_set_pr )
[263]	216	CALL handle_netcdf_error( 'close_file', 47 )
[1]	217	ENDIF
	218
	219	CASE ( 105 )
	220
	221	IF ( myid == 0 .AND. netcdf_output ) THEN
	222	nc_stat = NF90_CLOSE( id_set_ts )
[263]	223	CALL handle_netcdf_error( 'close_file', 48 )
[1]	224	ENDIF
	225
	226	CASE ( 106 )
	227
[493]	228	IF ( netcdf_output .AND. &
	229	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
[1]	230	nc_stat = NF90_CLOSE( id_set_3d(0) )
[263]	231	CALL handle_netcdf_error( 'close_file', 49 )
[1]	232	ENDIF
	233
	234	CASE ( 107 )
	235
	236	IF ( myid == 0 .AND. netcdf_output ) THEN
	237	nc_stat = NF90_CLOSE( id_set_sp )
[263]	238	CALL handle_netcdf_error( 'close_file', 50 )
[1]	239	ENDIF
	240
	241	CASE ( 108 )
	242
	243	IF ( netcdf_output ) THEN
	244	nc_stat = NF90_CLOSE( id_set_prt )
[263]	245	CALL handle_netcdf_error( 'close_file', 51 )
[1]	246	ENDIF
	247
	248	CASE ( 109 )
	249
	250	IF ( netcdf_output ) THEN
	251	nc_stat = NF90_CLOSE( id_set_pts )
[263]	252	CALL handle_netcdf_error( 'close_file', 412 )
[1]	253	ENDIF
	254
	255	CASE ( 111 )
	256
[493]	257	IF ( netcdf_output .AND. &
	258	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
[1]	259	nc_stat = NF90_CLOSE( id_set_xy(1) )
[263]	260	CALL handle_netcdf_error( 'close_file', 52 )
[1]	261	ENDIF
	262
	263	CASE ( 112 )
	264
[493]	265	IF ( netcdf_output .AND. &
	266	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
[1]	267	nc_stat = NF90_CLOSE( id_set_xz(1) )
[263]	268	CALL handle_netcdf_error( 'close_file', 352 )
[1]	269	ENDIF
	270
	271	CASE ( 113 )
	272
[493]	273	IF ( netcdf_output .AND. &
	274	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
[1]	275	nc_stat = NF90_CLOSE( id_set_yz(1) )
[263]	276	CALL handle_netcdf_error( 'close_file', 353 )
[1]	277	ENDIF
	278
	279	CASE ( 116 )
	280
[493]	281	IF ( netcdf_output .AND. &
	282	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
[1]	283	nc_stat = NF90_CLOSE( id_set_3d(1) )
[263]	284	CALL handle_netcdf_error( 'close_file', 353 )
[1]	285	ENDIF
	286
[564]	287	CASE ( 201:200+2*max_masks )
[410]	288
[493]	289	IF ( netcdf_output .AND. &
	290	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
[410]	291	!
	292	!-- decompose fid into mid and av
[564]	293	IF ( fid <= 200+max_masks ) THEN
	294	mid = fid - 200
[410]	295	av = 0
	296	ELSE
[564]	297	mid = fid - (200+max_masks)
[410]	298	av = 1
	299	ENDIF
	300	nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
[564]	301	CALL handle_netcdf_error( 'close_file', 459 )
[410]	302
	303	ENDIF
	304
[1]	305	#endif
	306
	307	END SELECT
	308	!
	309	!-- Close file
	310	IF ( openfile(fid)%opened ) CLOSE ( fid )
	311
	312	ENDIF
	313
	314	ENDDO
	315
	316	!
	317	!-- Formats
	318	3200 FORMAT ('# AVS',A,'field file'/ &
	319	'#'/ &
	320	'# ',A/ &
	321	'ndim=3'/ &
	322	'dim1=',I5/ &
	323	'dim2=',I5/ &
	324	'dim3=',I5/ &
	325	'nspace=3'/ &
	326	'veclen=',I5/ &
	327	'data=xdr_float'/ &
	328	'field=rectilinear')
	329	4000 FORMAT ('time averaged over',F7.1,' s')
	330
	331
	332	END SUBROUTINE close_file

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |