Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |