Home

Context Navigation

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

Last change on this file since 564 was 564, checked in by helmke, 14 years ago
several changes for an unlimited output of mask data and message IDs changed
Property svn:keywords set to `Id`
File size: 20.6 KB

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