Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |