Home

Context Navigation

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

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

Line
1	SUBROUTINE close_file( file_id )
2
3	!--------------------------------------------------------------------------------!
4	! This file is part of PALM.
5	!
6	! PALM is free software: you can redistribute it and/or modify it under the terms
7	! of the GNU General Public License as published by the Free Software Foundation,
8	! either version 3 of the License, or (at your option) any later version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2012 Leibniz University Hannover
18	!--------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: close_file.f90 1037 2012-10-22 14:10:22Z raasch $
27	!
28	! 1036 2012-10-22 13:43:42Z raasch
29	! code put under GPL (PALM 3.9)
30	!
31	! 1031 2012-10-19 14:35:30Z raasch
32	! netCDF4 without parallel file support implemented
33	!
34	! 964 2012-07-26 09:14:24Z raasch
35	! old profil-units (40:49) and respective code removed
36	!
37	! 564 2010-09-30 13:18:59Z helmke
38	! start number of mask output files changed to 201, netcdf message identifiers
39	! of masked output changed
40	!
41	! 493 2010-03-01 08:30:24Z raasch
42	! Adjustments for NetCDF parallel data output
43	!
44	! 410 2009-12-04 17:05:40Z letzel
45	! masked data output
46	!
47	! 263 2009-03-18 12:26:04Z heinze
48	! Output of NetCDF messages with aid of message handling routine.
49	!
50	! Feb. 2007
51	! RCS Log replace by Id keyword, revision history cleaned up
52	!
53	! Revision 1.10 2006/08/22 13:50:01 raasch
54	! xz and yz cross sections now up to nzt+1
55	!
56	! Revision 1.1 2001/01/02 17:23:41 raasch
57	! Initial revision
58	!
59	! Last revision before renaming subroutine 2001/01/01 raasch
60	! Subroutine name changed from close_files to close_file. Closing of a single
61	! file is allowed by passing its file-id as an argument. Variable openfile now
62	! is of type file_status and contains a flag which indicates if a file has
63	! been opened before. Old revision remarks deleted.
64	!
65	! Revision 1.13 (close_files) 2000/12/20 09:10:24 letzel
66	! All comments translated into English.
67	!
68	! Revision 1.12 (close_files) 1999/03/02 09:22:46 raasch
69	! FLD-Header fuer komprimierte 3D-Daten
70	!
71	! Revision 1.1 (close_files) 1997/08/11 06:11:18 raasch
72	! Initial revision
73	!
74	!
75	! Description:
76	! ------------
77	! Close specified file or all open files, if "0" has been given as the
78	! calling argument. In that case, execute last actions for certain unit
79	! numbers, if required.
80	!------------------------------------------------------------------------------!
81
82	USE control_parameters
83	USE grid_variables
84	USE indices
85	USE netcdf_control
86	USE pegrid
87	USE profil_parameter
88	USE statistics
89
90	IMPLICIT NONE
91
92	CHARACTER (LEN=2) :: suffix
93	CHARACTER (LEN=10) :: datform = 'lit_endian'
94	CHARACTER (LEN=80) :: rtext, title
95
96	INTEGER :: av, anzzeile, dimx, dimy, &
97	fid, file_id, j, k, planz
98
99	LOGICAL :: checkuf = .TRUE., datleg = .TRUE., dp = .FALSE., swap
100
101	REAL :: sizex, sizey, yright
102
103	NAMELIST /GLOBAL/ checkuf, datform, dimx, dimy, dp, planz, &
104	title
105	NAMELIST /RAHMEN/ anzzeile, datleg, rtext, swap
106
107	!
108	!-- Close specified unit number (if opened) and set a flag that it has
109	!-- been opened one time at least
110	IF ( file_id /= 0 ) THEN
111	IF ( openfile(file_id)%opened ) THEN
112	CLOSE ( file_id )
113	openfile(file_id)%opened = .FALSE.
114	openfile(file_id)%opened_before = .TRUE.
115	ENDIF
116	RETURN
117	ENDIF
118
119	!
120	!-- Close all open unit numbers
121	DO fid = 1, 200+2*max_masks
122
123	IF ( openfile(fid)%opened .OR. openfile(fid)%opened_before ) THEN
124	!
125	!-- Last actions for certain unit numbers
126	SELECT CASE ( fid )
127
128	CASE ( 21 )
129	!
130	!-- Write ISO2D global parameters
131	IF ( myid == 0 .AND. iso2d_output ) THEN
132	planz = do2d_xy_n
133	dimx = nx + 2
134	dimy = ny + 2
135	sizex = 100.0
136	sizey = 100.0
137	title = run_description_header
138	yright = ( ny + 1.0 ) * dy
139	IF ( host(1:3) == 'ibm' .OR. host(1:3) == 't3e' ) THEN
140	checkuf = .FALSE.; dp = .TRUE.
141	ENDIF
142	IF ( host(1:3) == 'ibm' .OR. host(1:3) == 'nec' ) THEN
143	datform = 'big_endian'
144	ENDIF
145	OPEN ( 90, FILE='PLOT2D_XY_GLOBAL', FORM='FORMATTED', &
146	DELIM='APOSTROPHE' )
147	WRITE ( 90, GLOBAL )
148	CLOSE ( 90 )
149	ENDIF
150
151	CASE ( 22 )
152	!
153	!-- Write ISO2D global parameters
154	IF ( myid == 0 ) THEN
155	planz = do2d_xz_n
156	dimx = nx + 2
157	dimy = nz + 2
158	sizex = 100.0
159	sizey = 65.0
160	title = run_description_header
161	yright = z_max_do2d
162	IF ( host(1:3) == 'ibm' .OR. host(1:3) == 't3e' ) THEN
163	checkuf = .FALSE.; dp = .TRUE.
164	ENDIF
165	IF ( host(1:3) == 'ibm' .OR. host(1:3) == 'nec' ) THEN
166	datform = 'big_endian'
167	ENDIF
168	OPEN ( 90, FILE='PLOT2D_XZ_GLOBAL', FORM='FORMATTED', &
169	DELIM='APOSTROPHE' )
170	WRITE ( 90, GLOBAL )
171	CLOSE ( 90 )
172	ENDIF
173
174	CASE ( 23 )
175	!
176	!-- Write ISO2D global parameters
177	IF ( myid == 0 ) THEN
178	planz = do2d_yz_n
179	dimx = ny + 2
180	dimy = nz + 2
181	sizex = 100.0
182	sizey = 65.0
183	title = run_description_header
184	yright = z_max_do2d
185	IF ( host(1:3) == 'ibm' .OR. host(1:3) == 't3e' ) THEN
186	checkuf = .FALSE.; dp = .TRUE.
187	ENDIF
188	IF ( host(1:3) == 'ibm' .OR. host(1:3) == 'nec' ) THEN
189	datform = 'big_endian'
190	ENDIF
191	OPEN ( 90, FILE='PLOT2D_YZ_GLOBAL', FORM='FORMATTED', &
192	DELIM='APOSTROPHE' )
193	WRITE ( 90, GLOBAL )
194	CLOSE ( 90 )
195	ENDIF
196
197	CASE ( 32 )
198	!
199	!-- Write header for FLD-file
200	IF ( do3d_compress ) THEN
201	WRITE ( 32, 3200) ' compressed ', &
202	TRIM( run_description_header ), nx+2, &
203	ny+2, nz_do3d+1, do3d_avs_n
204	ELSE
205	WRITE ( 32, 3200) ' ', TRIM( run_description_header ), &
206	nx+2, ny+2, nz_do3d+1, do3d_avs_n
207	ENDIF
208
209	#if defined( __netcdf )
210	CASE ( 101 )
211
212	IF ( netcdf_output .AND. &
213	( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN
214	nc_stat = NF90_CLOSE( id_set_xy(0) )
215	CALL handle_netcdf_error( 'close_file', 44 )
216	ENDIF
217
218	CASE ( 102 )
219
220	IF ( netcdf_output .AND. &
221	( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN
222	nc_stat = NF90_CLOSE( id_set_xz(0) )
223	CALL handle_netcdf_error( 'close_file', 45 )
224	ENDIF
225
226	CASE ( 103 )
227
228	IF ( netcdf_output .AND. &
229	( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN
230	nc_stat = NF90_CLOSE( id_set_yz(0) )
231	CALL handle_netcdf_error( 'close_file', 46 )
232	ENDIF
233
234	CASE ( 104 )
235
236	IF ( myid == 0 .AND. netcdf_output ) THEN
237	nc_stat = NF90_CLOSE( id_set_pr )
238	CALL handle_netcdf_error( 'close_file', 47 )
239	ENDIF
240
241	CASE ( 105 )
242
243	IF ( myid == 0 .AND. netcdf_output ) THEN
244	nc_stat = NF90_CLOSE( id_set_ts )
245	CALL handle_netcdf_error( 'close_file', 48 )
246	ENDIF
247
248	CASE ( 106 )
249
250	IF ( netcdf_output .AND. &
251	( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN
252	nc_stat = NF90_CLOSE( id_set_3d(0) )
253	CALL handle_netcdf_error( 'close_file', 49 )
254	ENDIF
255
256	CASE ( 107 )
257
258	IF ( myid == 0 .AND. netcdf_output ) THEN
259	nc_stat = NF90_CLOSE( id_set_sp )
260	CALL handle_netcdf_error( 'close_file', 50 )
261	ENDIF
262
263	CASE ( 108 )
264
265	IF ( netcdf_output ) THEN
266	nc_stat = NF90_CLOSE( id_set_prt )
267	CALL handle_netcdf_error( 'close_file', 51 )
268	ENDIF
269
270	CASE ( 109 )
271
272	IF ( netcdf_output ) THEN
273	nc_stat = NF90_CLOSE( id_set_pts )
274	CALL handle_netcdf_error( 'close_file', 412 )
275	ENDIF
276
277	CASE ( 111 )
278
279	IF ( netcdf_output .AND. &
280	( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN
281	nc_stat = NF90_CLOSE( id_set_xy(1) )
282	CALL handle_netcdf_error( 'close_file', 52 )
283	ENDIF
284
285	CASE ( 112 )
286
287	IF ( netcdf_output .AND. &
288	( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN
289	nc_stat = NF90_CLOSE( id_set_xz(1) )
290	CALL handle_netcdf_error( 'close_file', 352 )
291	ENDIF
292
293	CASE ( 113 )
294
295	IF ( netcdf_output .AND. &
296	( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN
297	nc_stat = NF90_CLOSE( id_set_yz(1) )
298	CALL handle_netcdf_error( 'close_file', 353 )
299	ENDIF
300
301	CASE ( 116 )
302
303	IF ( netcdf_output .AND. &
304	( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN
305	nc_stat = NF90_CLOSE( id_set_3d(1) )
306	CALL handle_netcdf_error( 'close_file', 353 )
307	ENDIF
308
309	CASE ( 201:200+2*max_masks )
310
311	IF ( netcdf_output .AND. &
312	( myid == 0 .OR. netcdf_data_format > 4 ) ) THEN
313	!
314	!-- decompose fid into mid and av
315	IF ( fid <= 200+max_masks ) THEN
316	mid = fid - 200
317	av = 0
318	ELSE
319	mid = fid - (200+max_masks)
320	av = 1
321	ENDIF
322	nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
323	CALL handle_netcdf_error( 'close_file', 459 )
324
325	ENDIF
326
327	#endif
328
329	END SELECT
330	!
331	!-- Close file
332	IF ( openfile(fid)%opened ) CLOSE ( fid )
333
334	ENDIF
335
336	ENDDO
337
338	!
339	!-- Formats
340	3200 FORMAT ('# AVS',A,'field file'/ &
341	'#'/ &
342	'# ',A/ &
343	'ndim=3'/ &
344	'dim1=',I5/ &
345	'dim2=',I5/ &
346	'dim3=',I5/ &
347	'nspace=3'/ &
348	'veclen=',I5/ &
349	'data=xdr_float'/ &
350	'field=rectilinear')
351	4000 FORMAT ('time averaged over',F7.1,' s')
352
353
354	END SUBROUTINE close_file

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |