Home

Context Navigation

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

Last change on this file since 47 was 4, checked in by raasch, 18 years ago
Id keyword set as property for all *.f90 files
Property svn:keywords set to `Id`
File size: 19.4 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |