Home

Context Navigation

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

Last change on this file since 487 was 449, checked in by raasch, 15 years ago
branch revision comments from Marcus (rev 410) replaced by normal revision comments
Property svn:keywords set to `Id`
File size: 20.3 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 449 2010-02-02 11:23:59Z raasch $
11	!
12	! 410 2009-12-04 17:05:40Z letzel
13	! masked data output
14	!
15	! 263 2009-03-18 12:26:04Z heinze
16	! Output of NetCDF messages with aid of message handling routine.
17	!
18	! Feb. 2007
19	! RCS Log replace by Id keyword, revision history cleaned up
20	!
21	! Revision 1.10 2006/08/22 13:50:01 raasch
22	! xz and yz cross sections now up to nzt+1
23	!
24	! Revision 1.1 2001/01/02 17:23:41 raasch
25	! Initial revision
26	!
27	! Last revision before renaming subroutine 2001/01/01 raasch
28	! Subroutine name changed from close_files to close_file. Closing of a single
29	! file is allowed by passing its file-id as an argument. Variable openfile now
30	! is of type file_status and contains a flag which indicates if a file has
31	! been opened before. Old revision remarks deleted.
32	!
33	! Revision 1.13 (close_files) 2000/12/20 09:10:24 letzel
34	! All comments translated into English.
35	!
36	! Revision 1.12 (close_files) 1999/03/02 09:22:46 raasch
37	! FLD-Header fuer komprimierte 3D-Daten
38	!
39	! Revision 1.1 (close_files) 1997/08/11 06:11:18 raasch
40	! Initial revision
41	!
42	!
43	! Description:
44	! ------------
45	! Close specified file or all open files, if "0" has been given as the
46	! calling argument. In that case, execute last actions for certain unit
47	! numbers, if required.
48	!------------------------------------------------------------------------------!
49
50	USE control_parameters
51	USE grid_variables
52	USE indices
53	USE netcdf_control
54	USE pegrid
55	USE profil_parameter
56	USE statistics
57
58	IMPLICIT NONE
59
60	CHARACTER (LEN=2) :: suffix
61	CHARACTER (LEN=10) :: datform = 'lit_endian'
62	CHARACTER (LEN=80) :: rtext, title, utext = '', xtext = '', ytext = ''
63
64	INTEGER :: av, anzzeile, cranz, cross_count, cross_numbers, dimx, dimy, &
65	fid, file_id, j, k, legpos = 1, planz, timodex = 1
66	INTEGER, DIMENSION(100) :: klist, lstyle, cucol
67
68	LOGICAL :: checkuf = .TRUE., datleg = .TRUE., dp = .FALSE., &
69	grid = .TRUE., rand = .TRUE., swap, twoxa = .TRUE., &
70	twoya = .TRUE.
71
72	REAL :: ansx = -999.999, ansy = -999.999, gwid = 0.1, rlegfak, &
73	sizex, sizey, texfac, utmove = 50.0, uxmax, uxmin, uymax, &
74	uymin, yright
75	REAL, DIMENSION(100) :: lwid, normx, normy
76
77	NAMELIST /CROSS/ ansx, ansy, cucol, grid, gwid, klist, legpos, lstyle, &
78	lwid, normx, normy, rand, rlegfak, sizex, sizey, &
79	texfac, timodex, twoxa, twoya, utext, utmove, uxmax, &
80	uxmin, uymax, uymin, xtext, ytext
81	NAMELIST /GLOBAL/ checkuf, datform, dimx, dimy, dp, planz, sizex, sizey, &
82	title, yright
83	NAMELIST /RAHMEN/ anzzeile, cranz, 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, 160
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	CASE ( 40:49 )
188	!
189	!-- Write PROFIL namelist parameters for 1D profiles.
190	!-- First determine, how many crosses are to be drawn.
191	IF ( myid == 0 ) THEN
192	cross_numbers = 0
193	DO j = 1, crmax
194	IF ( cross_profile_number_count(j) /= 0 ) THEN
195	cross_numbers = cross_numbers + 1
196	ENDIF
197	ENDDO
198
199	IF ( cross_numbers /= 0 ) THEN
200	!
201	!-- Determine remaining RAHMEN parameters
202	swap = .FALSE.
203	rtext = '\0.5 ' // TRIM( run_description_header ) // &
204	' ' // TRIM( region( fid - 40 ) )
205	!
206	!-- Write RAHMEN parameters
207	IF ( statistic_regions == 0 .AND. fid == 40 ) THEN
208	suffix = ''
209	ELSE
210	WRITE ( suffix, '(''_'',I1)' ) fid - 40
211	ENDIF
212	OPEN ( 90, FILE='PLOT1D_PAR' // TRIM( suffix ), &
213	FORM='FORMATTED', DELIM='APOSTROPHE' )
214	!
215	!-- Subtitle for crosses with time averaging
216	IF ( averaging_interval_pr /= 0.0 ) THEN
217	WRITE ( utext, 4000 ) averaging_interval_pr
218	ENDIF
219	!
220	!-- Determine and write CROSS parameters for each individual
221	!-- cross
222	cross_count = 0
223	DO j = 1, crmax
224	k = cross_profile_number_count(j)
225	IF ( k /= 0 ) THEN
226	cross_count = cross_count + 1
227	!
228	!-- Write RAHMEN parameters
229	IF ( MOD( cross_count-1, &
230	profile_rows*profile_columns ) == 0 ) &
231	THEN
232	!
233	!-- Determine number of crosses still to be drawn
234	cranz = MIN( cross_numbers - cross_count + 1, &
235	profile_rows * profile_columns )
236	!
237	!-- If the first line cannot be filled with crosses
238	!-- completely, the default number of crosses per
239	!-- line has to be reduced.
240	IF ( cranz < profile_columns ) THEN
241	anzzeile = cranz
242	ELSE
243	anzzeile = profile_columns
244	ENDIF
245
246	WRITE ( 90, RAHMEN )
247
248	ENDIF
249	!
250	!-- Store graph numbers
251	klist(1:k) = cross_profile_numbers(1:k,j)
252	klist(k+1:100) = 999999
253	!
254	!-- Store graph attributes
255	cucol = cross_linecolors(:,j)
256	lstyle = cross_linestyles(:,j)
257	lwid = 0.6
258	!
259	!-- Sizes, text etc.
260	sizex = 100.0; sizey = 120.0
261	rlegfak = 0.7; texfac = 1.0
262	!
263	!-- Determine range of x-axis values
264	IF ( cross_normalized_x(j) == ' ' ) THEN
265	!
266	!-- Non-normalized profiles
267	IF ( cross_uxmin(j) == 0.0 .AND. &
268	cross_uxmax(j) == 0.0 ) THEN
269	uxmin = cross_uxmin_computed(j)
270	uxmax = cross_uxmax_computed(j)
271	IF ( uxmin == uxmax ) uxmax = uxmin + 1.0
272	ELSE
273	!
274	!-- Values set in check_parameters are used here
275	uxmin = cross_uxmin(j); uxmax = cross_uxmax(j)
276	ENDIF
277	ELSE
278	!
279	!-- Normalized profiles
280	IF ( cross_uxmin_normalized(j) == 0.0 .AND. &
281	cross_uxmax_normalized(j) == 0.0 ) THEN
282	uxmin = cross_uxmin_normalized_computed(j)
283	uxmax = cross_uxmax_normalized_computed(j)
284	IF ( uxmin == uxmax ) uxmax = uxmin + 1.0
285	ELSE
286	!
287	!-- Values set in check_parameters are used here
288	uxmin = cross_uxmin_normalized(j)
289	uxmax = cross_uxmax_normalized(j)
290	ENDIF
291	ENDIF
292	!
293	!-- Range of y-axis values
294	!-- may be re-adjusted during normalization if required
295	uymin = cross_uymin(j); uymax = cross_uymax(j)
296	ytext = 'height in m'
297	!
298	!-- Normalization of the axes
299	normx = cross_normx_factor(:,j)
300	normy = cross_normy_factor(:,j)
301	!
302	!-- Labelling of the axes
303	IF ( cross_normalized_x(j) == ' ' ) THEN
304	xtext = cross_xtext(j)
305	ELSE
306	xtext = TRIM( cross_xtext(j) ) // ' / ' // &
307	cross_normalized_x(j)
308	ENDIF
309	IF ( cross_normalized_y(j) == ' ' ) THEN
310	ytext = 'height in m'
311	ELSE
312	ytext = 'height in m' // ' / ' // &
313	cross_normalized_y(j)
314	!
315	!-- Determine upper limit of value range
316	IF ( z_max_do1d_normalized /= -1.0 ) THEN
317	uymax = z_max_do1d_normalized
318	ENDIF
319	ENDIF
320
321	WRITE ( 90, CROSS )
322
323	ENDIF
324	ENDDO
325
326	CLOSE ( 90 )
327	ENDIF
328	ENDIF
329
330	CASE ( 50:59 )
331	!
332	!-- Write PROFIL namelist parameters for time series
333	!-- first determine number of crosses to be drawn
334	IF ( myid == 0 ) THEN
335	cranz = 0
336	DO j = 1, 12
337	IF ( cross_ts_number_count(j) /= 0 ) cranz = cranz+1
338	ENDDO
339
340	IF ( cranz /= 0 ) THEN
341	!
342	!-- Determine RAHMEN parameters
343	anzzeile = 1
344	swap = .TRUE.
345	rtext = '\1.0 ' // TRIM( run_description_header ) // &
346	' ' // TRIM( region( fid - 50 ) )
347	!
348	!-- Write RAHMEN parameters
349	IF ( statistic_regions == 0 .AND. fid == 50 ) THEN
350	suffix = ''
351	ELSE
352	WRITE ( suffix, '(''_'',I1)' ) fid - 50
353	ENDIF
354	OPEN ( 90, FILE='PLOTTS_PAR' // TRIM( suffix ), &
355	FORM='FORMATTED', DELIM='APOSTROPHE' )
356	WRITE ( 90, RAHMEN )
357	!
358	!-- Determine and write CROSS parameters for each individual
359	!-- cross
360	DO j = 1, 12
361	k = cross_ts_number_count(j)
362	IF ( k /= 0 ) THEN
363	!
364	!-- Store graph numbers
365	klist(1:k) = cross_ts_numbers(1:k,j)
366	klist(k+1:100) = 999999
367	!
368	!-- Store graph attributes
369	cucol(1:k) = linecolors(1:k)
370	lstyle(1:k) = linestyles(1:k)
371	lwid = 0.4
372	!
373	!-- Sizes, text etc.
374	sizex = 250.0; sizey = 40.0
375	rlegfak = 1.5; texfac = 1.5
376	xtext = 'time in s'
377	ytext = ''
378	utext = ''
379	!
380	!-- Determine range of y-axis values
381	IF ( cross_ts_uymin(j) == 999.999 ) THEN
382	uymin = cross_ts_uymin_computed(j)
383	ELSE
384	uymin = cross_ts_uymin(j)
385	ENDIF
386	IF ( cross_ts_uymax(j) == 999.999 ) THEN
387	uymax = cross_ts_uymax_computed(j)
388	ELSE
389	uymax = cross_ts_uymax(j)
390	ENDIF
391	IF ( uymin == uymax ) uymax = uymin + 1.0
392	!
393	!-- Range of x-axis values
394	uxmin = 0.0; uxmax = simulated_time
395	!
396	!-- Normalizations
397	normx = 1.0; normy = 1.0
398
399	WRITE ( 90, CROSS )
400
401	ENDIF
402	ENDDO
403
404	CLOSE ( 90 )
405	ENDIF
406	ENDIF
407
408	#if defined( __netcdf )
409	CASE ( 101 )
410
411	IF ( myid == 0 .AND. netcdf_output ) THEN
412	nc_stat = NF90_CLOSE( id_set_xy(0) )
413	CALL handle_netcdf_error( 'close_file', 44 )
414	ENDIF
415
416	CASE ( 102 )
417
418	IF ( myid == 0 .AND. netcdf_output ) THEN
419	nc_stat = NF90_CLOSE( id_set_xz(0) )
420	CALL handle_netcdf_error( 'close_file', 45 )
421	ENDIF
422
423	CASE ( 103 )
424
425	IF ( myid == 0 .AND. netcdf_output ) THEN
426	nc_stat = NF90_CLOSE( id_set_yz(0) )
427	CALL handle_netcdf_error( 'close_file', 46 )
428	ENDIF
429
430	CASE ( 104 )
431
432	IF ( myid == 0 .AND. netcdf_output ) THEN
433	nc_stat = NF90_CLOSE( id_set_pr )
434	CALL handle_netcdf_error( 'close_file', 47 )
435	ENDIF
436
437	CASE ( 105 )
438
439	IF ( myid == 0 .AND. netcdf_output ) THEN
440	nc_stat = NF90_CLOSE( id_set_ts )
441	CALL handle_netcdf_error( 'close_file', 48 )
442	ENDIF
443
444	CASE ( 106 )
445
446	IF ( myid == 0 .AND. netcdf_output ) THEN
447	nc_stat = NF90_CLOSE( id_set_3d(0) )
448	CALL handle_netcdf_error( 'close_file', 49 )
449	ENDIF
450
451	CASE ( 107 )
452
453	IF ( myid == 0 .AND. netcdf_output ) THEN
454	nc_stat = NF90_CLOSE( id_set_sp )
455	CALL handle_netcdf_error( 'close_file', 50 )
456	ENDIF
457
458	CASE ( 108 )
459
460	IF ( netcdf_output ) THEN
461	nc_stat = NF90_CLOSE( id_set_prt )
462	CALL handle_netcdf_error( 'close_file', 51 )
463	ENDIF
464
465	CASE ( 109 )
466
467	IF ( netcdf_output ) THEN
468	nc_stat = NF90_CLOSE( id_set_pts )
469	CALL handle_netcdf_error( 'close_file', 412 )
470	ENDIF
471
472	CASE ( 111 )
473
474	IF ( myid == 0 .AND. netcdf_output ) THEN
475	nc_stat = NF90_CLOSE( id_set_xy(1) )
476	CALL handle_netcdf_error( 'close_file', 52 )
477	ENDIF
478
479	CASE ( 112 )
480
481	IF ( myid == 0 .AND. netcdf_output ) THEN
482	nc_stat = NF90_CLOSE( id_set_xz(1) )
483	CALL handle_netcdf_error( 'close_file', 352 )
484	ENDIF
485
486	CASE ( 113 )
487
488	IF ( myid == 0 .AND. netcdf_output ) THEN
489	nc_stat = NF90_CLOSE( id_set_yz(1) )
490	CALL handle_netcdf_error( 'close_file', 353 )
491	ENDIF
492
493	CASE ( 116 )
494
495	IF ( myid == 0 .AND. netcdf_output ) THEN
496	nc_stat = NF90_CLOSE( id_set_3d(1) )
497	CALL handle_netcdf_error( 'close_file', 353 )
498	ENDIF
499
500	CASE ( 121:160 )
501
502	IF ( format_parallel_io ) THEN
503	!
504	!-- decompose fid into mid and av
505	IF ( fid <= 140 ) THEN
506	mid = fid - 120
507	av = 0
508	ELSE
509	mid = fid - 140
510	av = 1
511	ENDIF
512	nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
513	CALL handle_netcdf_error( 'close_file', 9998 )
514
515	ELSEIF ( myid == 0 .AND. netcdf_output ) THEN
516	!
517	!-- decompose fid into mid and av
518	IF ( fid <= 140 ) THEN
519	mid = fid - 120
520	av = 0
521	ELSE
522	mid = fid - 140
523	av = 1
524	ENDIF
525	nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
526	CALL handle_netcdf_error( 'close_file', 9998 )
527
528	ENDIF
529
530	#endif
531
532	END SELECT
533	!
534	!-- Close file
535	IF ( openfile(fid)%opened ) CLOSE ( fid )
536
537	ENDIF
538
539	ENDDO
540
541	!
542	!-- Formats
543	3200 FORMAT ('# AVS',A,'field file'/ &
544	'#'/ &
545	'# ',A/ &
546	'ndim=3'/ &
547	'dim1=',I5/ &
548	'dim2=',I5/ &
549	'dim3=',I5/ &
550	'nspace=3'/ &
551	'veclen=',I5/ &
552	'data=xdr_float'/ &
553	'field=rectilinear')
554	4000 FORMAT ('time averaged over',F7.1,' s')
555
556
557	END SUBROUTINE close_file

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |