Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |