Home

Context Navigation

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

Last change on this file since 1 was 1, checked in by raasch, 18 years ago
Initial repository layout and content
File size: 20.3 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |