Home

Context Navigation

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

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

Line
1	SUBROUTINE close_file( file_id )
2
3	!------------------------------------------------------------------------------!
4	! Current revisions:
5	! -----------------
6	!
7	!
8	! Former revisions:
9	! -----------------
10	! $Id: close_file.f90 965 2012-07-26 09:29:52Z franke $
11	!
12	! 964 2012-07-26 09:14:24Z raasch
13	! old profil-units (40:49) and respective code removed
14	!
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	!
19	! 493 2010-03-01 08:30:24Z raasch
20	! Adjustments for NetCDF parallel data output
21	!
22	! 410 2009-12-04 17:05:40Z letzel
23	! masked data output
24	!
25	! 263 2009-03-18 12:26:04Z heinze
26	! Output of NetCDF messages with aid of message handling routine.
27	!
28	! Feb. 2007
29	! RCS Log replace by Id keyword, revision history cleaned up
30	!
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'
72	CHARACTER (LEN=80) :: rtext, title
73
74	INTEGER :: av, anzzeile, dimx, dimy, &
75	fid, file_id, j, k, planz
76
77	LOGICAL :: checkuf = .TRUE., datleg = .TRUE., dp = .FALSE., swap
78
79	REAL :: sizex, sizey, yright
80
81	NAMELIST /GLOBAL/ checkuf, datform, dimx, dimy, dp, planz, &
82	title
83	NAMELIST /RAHMEN/ anzzeile, 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
99	DO fid = 1, 200+2*max_masks
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
190	IF ( netcdf_output .AND. &
191	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
192	nc_stat = NF90_CLOSE( id_set_xy(0) )
193	CALL handle_netcdf_error( 'close_file', 44 )
194	ENDIF
195
196	CASE ( 102 )
197
198	IF ( netcdf_output .AND. &
199	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
200	nc_stat = NF90_CLOSE( id_set_xz(0) )
201	CALL handle_netcdf_error( 'close_file', 45 )
202	ENDIF
203
204	CASE ( 103 )
205
206	IF ( netcdf_output .AND. &
207	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
208	nc_stat = NF90_CLOSE( id_set_yz(0) )
209	CALL handle_netcdf_error( 'close_file', 46 )
210	ENDIF
211
212	CASE ( 104 )
213
214	IF ( myid == 0 .AND. netcdf_output ) THEN
215	nc_stat = NF90_CLOSE( id_set_pr )
216	CALL handle_netcdf_error( 'close_file', 47 )
217	ENDIF
218
219	CASE ( 105 )
220
221	IF ( myid == 0 .AND. netcdf_output ) THEN
222	nc_stat = NF90_CLOSE( id_set_ts )
223	CALL handle_netcdf_error( 'close_file', 48 )
224	ENDIF
225
226	CASE ( 106 )
227
228	IF ( netcdf_output .AND. &
229	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
230	nc_stat = NF90_CLOSE( id_set_3d(0) )
231	CALL handle_netcdf_error( 'close_file', 49 )
232	ENDIF
233
234	CASE ( 107 )
235
236	IF ( myid == 0 .AND. netcdf_output ) THEN
237	nc_stat = NF90_CLOSE( id_set_sp )
238	CALL handle_netcdf_error( 'close_file', 50 )
239	ENDIF
240
241	CASE ( 108 )
242
243	IF ( netcdf_output ) THEN
244	nc_stat = NF90_CLOSE( id_set_prt )
245	CALL handle_netcdf_error( 'close_file', 51 )
246	ENDIF
247
248	CASE ( 109 )
249
250	IF ( netcdf_output ) THEN
251	nc_stat = NF90_CLOSE( id_set_pts )
252	CALL handle_netcdf_error( 'close_file', 412 )
253	ENDIF
254
255	CASE ( 111 )
256
257	IF ( netcdf_output .AND. &
258	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
259	nc_stat = NF90_CLOSE( id_set_xy(1) )
260	CALL handle_netcdf_error( 'close_file', 52 )
261	ENDIF
262
263	CASE ( 112 )
264
265	IF ( netcdf_output .AND. &
266	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
267	nc_stat = NF90_CLOSE( id_set_xz(1) )
268	CALL handle_netcdf_error( 'close_file', 352 )
269	ENDIF
270
271	CASE ( 113 )
272
273	IF ( netcdf_output .AND. &
274	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
275	nc_stat = NF90_CLOSE( id_set_yz(1) )
276	CALL handle_netcdf_error( 'close_file', 353 )
277	ENDIF
278
279	CASE ( 116 )
280
281	IF ( netcdf_output .AND. &
282	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
283	nc_stat = NF90_CLOSE( id_set_3d(1) )
284	CALL handle_netcdf_error( 'close_file', 353 )
285	ENDIF
286
287	CASE ( 201:200+2*max_masks )
288
289	IF ( netcdf_output .AND. &
290	( myid == 0 .OR. netcdf_data_format > 2 ) ) THEN
291	!
292	!-- decompose fid into mid and av
293	IF ( fid <= 200+max_masks ) THEN
294	mid = fid - 200
295	av = 0
296	ELSE
297	mid = fid - (200+max_masks)
298	av = 1
299	ENDIF
300	nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
301	CALL handle_netcdf_error( 'close_file', 459 )
302
303	ENDIF
304
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 |