Home

Context Navigation

source: palm/trunk/SOURCE/check_open.f90 @ 3726

Last change on this file since 3726 was 3705, checked in by suehring, 6 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 45.0 KB

Line
1	!> @file check_open.f90
2	!------------------------------------------------------------------------------!
3	! This file is part of the PALM model system.
4	!
5	! PALM is free software: you can redistribute it and/or modify it under the
6	! terms of the GNU General Public License as published by the Free Software
7	! Foundation, either version 3 of the License, or (at your option) any later
8	! version.
9	!
10	! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11	! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12	! A PARTICULAR PURPOSE. See the GNU General Public License for more details.
13	!
14	! You should have received a copy of the GNU General Public License along with
15	! PALM. If not, see <http://www.gnu.org/licenses/>.
16	!
17	! Copyright 1997-2019 Leibniz Universitaet Hannover
18	!------------------------------------------------------------------------------!
19	!
20	! Current revisions:
21	! -----------------
22	!
23	!
24	! Former revisions:
25	! -----------------
26	! $Id: check_open.f90 3705 2019-01-29 19:56:39Z maronga $
27	! Open binary files for virtual measurements
28	!
29	! 3704 2019-01-29 19:51:41Z suehring
30	! Open files for surface data
31	!
32	! 3399 2018-10-22 20:13:45Z gronemeier
33	! unused variables and format statements removed
34	!
35	! 3159 2018-07-20 11:20:01Z sward
36	! Added multi agent system
37	!
38	! 3045 2018-05-28 07:55:41Z Giersch
39	! Output case 108 disabled
40	!
41	! 2964 2018-04-12 16:04:03Z Giersch
42	! Error message moved to radiation_model_mod
43	!
44	! 2957 2018-04-11 08:48:06Z Giersch
45	! Error message has been corrected in case of writing sky view factors
46	!
47	! 2906 2018-03-19 08:56:40Z Giersch
48	! CASE 88 and 89 has been added for the input/output of sky view factors
49	!
50	! 2718 2018-01-02 08:49:38Z maronga
51	! Corrected "Former revisions" section
52	!
53	! 2696 2017-12-14 17:12:51Z kanani
54	! Change in file header (GPL part)
55	!
56	! 2669 2017-12-06 16:03:27Z raasch
57	! file name extension for masked data files is changed to "_M##" and is now
58	! appended at the end of the filename,
59	! file ids not used any more have been removed
60	!
61	! 2516 2017-10-04 11:03:04Z suehring
62	! Remove tabs
63	!
64	! 2514 2017-10-04 09:52:37Z suehring
65	! upper bounds of cross section and 3d output changed from nx+1,ny+1 to nx,ny
66	! no output of ghost layer data
67	! iso2d-related parts removed
68	!
69	! 2300 2017-06-29 13:31:14Z raasch
70	! -host
71	!
72	! 2298 2017-06-29 09:28:18Z raasch
73	! -return_addres, return_username, avs_coor_file_..., avs_data_file_...,
74	! cross_ts_numbers, cross_ts_number_count
75	!
76	! 2101 2017-01-05 16:42:31Z suehring
77	!
78	! 2063 2016-11-10 17:14:35Z raasch
79	! bugfix: opening of PROGRESS file moved out of the NetCDF block
80	!
81	! 2040 2016-10-26 16:58:09Z gronemeier
82	! Removed open of file 'PLOTTS_DATA' ( CASE(50:59) ) as it is no longer needed
83	!
84	! 2000 2016-08-20 18:09:15Z knoop
85	! Forced header and separation lines into 80 columns
86	!
87	! 1988 2016-08-10 14:49:06Z gronemeier
88	! informative message added if files cannot be opened in newly created directory
89	!
90	! 1986 2016-08-10 14:07:17Z gronemeier
91	! Bugfix: check if output can be opened in newly created directory. If not
92	! wait one second and try again.
93	!
94	! 1974 2016-07-26 08:43:25Z gronemeier
95	! Bugfix: MPI barriers after deleting non-extendable files must only be called
96	! in case of parallel I/O
97	!
98	! 1957 2016-07-07 10:43:48Z suehring
99	! flight module added
100	!
101	! 1804 2016-04-05 16:30:18Z maronga
102	! Removed code for parameter file check (__check)
103	!
104	! 1783 2016-03-06 18:36:17Z raasch
105	! name change of netcdf routines and module + related changes
106	!
107	! 1779 2016-03-03 08:01:28Z raasch
108	! coupling_char is trimmed at every place it occurs, because it can have
109	! different length now
110	!
111	! 1745 2016-02-05 13:06:51Z gronemeier
112	! Bugfix: added MPI barrier after deleting existing non-extendable file by PE0
113	!
114	! 1682 2015-10-07 23:56:08Z knoop
115	! Code annotations made doxygen readable
116	!
117	! 1551 2015-03-03 14:18:16Z maronga
118	! Removed redundant output for combine_plot_fields
119	!
120	! 1468 2014-09-24 14:06:57Z maronga
121	! Adapted for use on up to 6-digit processor cores
122	! Added file unit 117 (PROGRESS)
123	!
124	! 1359 2014-04-11 17:15:14Z hoffmann
125	! Format of particle exchange statistics extended to reasonable numbers of
126	! particles.
127	!
128	! 1353 2014-04-08 15:21:23Z heinze
129	! REAL constants provided with KIND-attribute,
130	! declaration for unused variables xkoor, ykoor, zkoor removed
131	!
132	! 1327 2014-03-21 11:00:16Z raasch
133	! parts concerning iso2d and avs output removed
134	!
135	! 1320 2014-03-20 08:40:49Z raasch
136	! ONLY-attribute added to USE-statements,
137	! kind-parameters added to all INTEGER and REAL declaration statements,
138	! kinds are defined in new module kinds,
139	! old module precision_kind is removed,
140	! revision history before 2012 removed,
141	! comment fields (!:) to be used for variable explanations added to
142	! all variable declaration statements
143	!
144	! 1106 2013-03-04 05:31:38Z raasch
145	! array_kind renamed precision_kind
146	!
147	! 1092 2013-02-02 11:24:22Z raasch
148	! unused variables removed
149	!
150	! 1036 2012-10-22 13:43:42Z raasch
151	! code put under GPL (PALM 3.9)
152	!
153	! 1031 2012-10-19 14:35:30Z raasch
154	! netCDF4 without parallel file support implemented,
155	! opening of netCDF files are done by new routines create_netcdf_file and
156	! open_write_netcdf_file
157	!
158	! 964 2012-07-26 09:14:24Z raasch
159	! old profil-units (40:49) removed,
160	! append feature removed from unit 14
161	!
162	! 849 2012-03-15 10:35:09Z raasch
163	! comment changed
164	!
165	! 809 2012-01-30 13:32:58Z maronga
166	! Bugfix: replaced .AND. and .NOT. with && and ! in the preprocessor directives
167	!
168	! 807 2012-01-25 11:53:51Z maronga
169	! New cpp directive "__check" implemented which is used by check_namelist_files
170	!
171	! Revision 1.1 1997/08/11 06:10:55 raasch
172	! Initial revision
173	!
174	!
175	! Description:
176	! ------------
177	!> Check if file unit is open. If not, open file and, if necessary, write a
178	!> header or start other initializing actions, respectively.
179	!------------------------------------------------------------------------------!
180	SUBROUTINE check_open( file_id )
181
182
183	USE control_parameters, &
184	ONLY: coupling_char, data_output_2d_on_each_pe, &
185	max_masks, message_string, mid, nz_do3d, openfile, &
186	run_description_header
187
188	USE indices, &
189	ONLY: nbgp, nx, nxl, nxr, ny, nyn, nys, nz, nzb, nzt
190
191	USE kinds
192
193	#if defined( __netcdf )
194	USE NETCDF
195	#endif
196
197	USE netcdf_interface, &
198	ONLY: id_set_agt, id_set_fl, id_set_mask, id_set_pr, &
199	id_set_pts, id_set_sp, id_set_ts, id_set_xy, id_set_xz, &
200	id_set_yz, id_set_3d, nc_stat, netcdf_create_file, &
201	netcdf_data_format, netcdf_define_header, netcdf_handle_error, &
202	netcdf_open_write_file
203
204	USE particle_attributes, &
205	ONLY: max_number_of_particle_groups, number_of_particle_groups, &
206	particle_groups
207
208	USE pegrid
209
210	USE posix_calls_from_fortran, &
211	ONLY: fortran_sleep
212
213
214	IMPLICIT NONE
215
216	CHARACTER (LEN=4) :: mask_char !<
217	CHARACTER (LEN=30) :: filename !<
218	CHARACTER (LEN=80) :: rtext !<
219
220	INTEGER(iwp) :: av !<
221	INTEGER(iwp) :: file_id !<
222	INTEGER(iwp) :: ioerr !< IOSTAT flag for IO-commands ( 0 = no error )
223
224	LOGICAL :: netcdf_extend !<
225
226	!
227	!-- Immediate return if file already open
228	IF ( openfile(file_id)%opened ) RETURN
229
230	!
231	!-- Only certain files are allowed to be re-opened
232	!-- NOTE: some of the other files perhaps also could be re-opened, but it
233	!-- has not been checked so far, if it works!
234	IF ( openfile(file_id)%opened_before ) THEN
235	SELECT CASE ( file_id )
236	CASE ( 13, 14, 21, 22, 23, 80, 85, 117 )
237	IF ( file_id == 14 .AND. openfile(file_id)%opened_before ) THEN
238	message_string = 're-open of unit ' // &
239	'14 is not verified. Please check results!'
240	CALL message( 'check_open', 'PA0165', 0, 1, 0, 6, 0 )
241	ENDIF
242
243	CASE DEFAULT
244	WRITE( message_string, * ) 're-opening of file-id ', file_id, &
245	' is not allowed'
246	CALL message( 'check_open', 'PA0166', 0, 1, 0, 6, 0 )
247
248	RETURN
249
250	END SELECT
251	ENDIF
252
253	!
254	!-- Check if file may be opened on the relevant PE
255	SELECT CASE ( file_id )
256
257	CASE ( 15, 16, 17, 18, 19, 50:59, 104:105, 107, 109, 117 )
258
259	IF ( myid /= 0 ) THEN
260	WRITE( message_string, * ) 'opening file-id ',file_id, &
261	' not allowed for PE ',myid
262	CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
263	ENDIF
264
265	CASE ( 101:103, 106, 111:113, 116, 201:200+2*max_masks )
266
267	IF ( netcdf_data_format < 5 ) THEN
268
269	IF ( myid /= 0 ) THEN
270	WRITE( message_string, * ) 'opening file-id ',file_id, &
271	' not allowed for PE ',myid
272	CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
273	ENDIF
274
275	ENDIF
276
277	CASE ( 21, 22, 23 )
278
279	IF ( .NOT. data_output_2d_on_each_pe ) THEN
280	IF ( myid /= 0 ) THEN
281	WRITE( message_string, * ) 'opening file-id ',file_id, &
282	' not allowed for PE ',myid
283	CALL message( 'check_open', 'PA0167', 2, 2, -1, 6, 1 )
284	END IF
285	ENDIF
286
287	CASE ( 90:99 )
288
289	!
290	!-- File-ids that are used temporarily in other routines
291	WRITE( message_string, * ) 'opening file-id ',file_id, &
292	' is not allowed since it is used otherwise'
293	CALL message( 'check_open', 'PA0168', 0, 1, 0, 6, 0 )
294
295	END SELECT
296
297	!
298	!-- Open relevant files
299	SELECT CASE ( file_id )
300
301	CASE ( 11 )
302
303	OPEN ( 11, FILE='PARIN'//TRIM( coupling_char ), FORM='FORMATTED', &
304	STATUS='OLD' )
305
306	CASE ( 13 )
307
308	IF ( myid_char == '' ) THEN
309	OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//myid_char, &
310	FORM='UNFORMATTED', STATUS='OLD' )
311	ELSE
312	!
313	!-- First opening of unit 13 openes file _000000 on all PEs because
314	!-- only this file contains the global variables
315	IF ( .NOT. openfile(file_id)%opened_before ) THEN
316	OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/_000000', &
317	FORM='UNFORMATTED', STATUS='OLD' )
318	ELSE
319	OPEN ( 13, FILE='BININ'//TRIM( coupling_char )//'/'// &
320	myid_char, FORM='UNFORMATTED', STATUS='OLD' )
321	ENDIF
322	ENDIF
323
324	CASE ( 14 )
325
326	IF ( myid_char == '' ) THEN
327	OPEN ( 14, FILE='BINOUT'//TRIM( coupling_char )//myid_char, &
328	FORM='UNFORMATTED', POSITION='APPEND' )
329	ELSE
330	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
331	CALL local_system( 'mkdir BINOUT' // TRIM( coupling_char ) )
332	ENDIF
333	#if defined( __parallel )
334	!
335	!-- Set a barrier in order to allow that all other processors in the
336	!-- directory created by PE0 can open their file
337	CALL MPI_BARRIER( comm2d, ierr )
338	#endif
339	ioerr = 1
340	DO WHILE ( ioerr /= 0 )
341	OPEN ( 14, FILE='BINOUT'//TRIM(coupling_char)//'/'//myid_char, &
342	FORM='UNFORMATTED', IOSTAT=ioerr )
343	IF ( ioerr /= 0 ) THEN
344	WRITE( 9, * ) '*** could not open "BINOUT'// &
345	TRIM(coupling_char)//'/'//myid_char// &
346	'"! Trying again in 1 sec.'
347	CALL fortran_sleep( 1 )
348	ENDIF
349	ENDDO
350
351	ENDIF
352
353	CASE ( 15 )
354
355	OPEN ( 15, FILE='RUN_CONTROL'//TRIM( coupling_char ), &
356	FORM='FORMATTED' )
357
358	CASE ( 16 )
359
360	OPEN ( 16, FILE='LIST_PROFIL'//TRIM( coupling_char ), &
361	FORM='FORMATTED' )
362
363	CASE ( 17 )
364
365	OPEN ( 17, FILE='LIST_PROFIL_1D'//TRIM( coupling_char ), &
366	FORM='FORMATTED' )
367
368	CASE ( 18 )
369
370	OPEN ( 18, FILE='CPU_MEASURES'//TRIM( coupling_char ), &
371	FORM='FORMATTED' )
372
373	CASE ( 19 )
374
375	OPEN ( 19, FILE='HEADER'//TRIM( coupling_char ), FORM='FORMATTED' )
376
377	CASE ( 20 )
378
379	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
380	CALL local_system( 'mkdir DATA_LOG' // TRIM( coupling_char ) )
381	ENDIF
382	IF ( myid_char == '' ) THEN
383	OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/_000000', &
384	FORM='UNFORMATTED', POSITION='APPEND' )
385	ELSE
386	#if defined( __parallel )
387	!
388	!-- Set a barrier in order to allow that all other processors in the
389	!-- directory created by PE0 can open their file
390	CALL MPI_BARRIER( comm2d, ierr )
391	#endif
392	ioerr = 1
393	DO WHILE ( ioerr /= 0 )
394	OPEN ( 20, FILE='DATA_LOG'//TRIM( coupling_char )//'/'// &
395	myid_char, FORM='UNFORMATTED', POSITION='APPEND', &
396	IOSTAT=ioerr )
397	IF ( ioerr /= 0 ) THEN
398	WRITE( 9, * ) '*** could not open "DATA_LOG'// &
399	TRIM( coupling_char )//'/'//myid_char// &
400	'"! Trying again in 1 sec.'
401	CALL fortran_sleep( 1 )
402	ENDIF
403	ENDDO
404
405	ENDIF
406
407	CASE ( 21 )
408
409	IF ( data_output_2d_on_each_pe ) THEN
410	OPEN ( 21, FILE='PLOT2D_XY'//TRIM( coupling_char )//myid_char, &
411	FORM='UNFORMATTED', POSITION='APPEND' )
412	ELSE
413	OPEN ( 21, FILE='PLOT2D_XY'//TRIM( coupling_char ), &
414	FORM='UNFORMATTED', POSITION='APPEND' )
415	ENDIF
416
417	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
418	!
419	!-- Write index bounds of total domain for combine_plot_fields
420	IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN
421	WRITE (21) 0, nx, 0, ny
422	ENDIF
423
424	ENDIF
425
426	CASE ( 22 )
427
428	IF ( data_output_2d_on_each_pe ) THEN
429	OPEN ( 22, FILE='PLOT2D_XZ'//TRIM( coupling_char )//myid_char, &
430	FORM='UNFORMATTED', POSITION='APPEND' )
431	ELSE
432	OPEN ( 22, FILE='PLOT2D_XZ'//TRIM( coupling_char ), &
433	FORM='UNFORMATTED', POSITION='APPEND' )
434	ENDIF
435
436	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
437	!
438	!-- Write index bounds of total domain for combine_plot_fields
439	IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN
440	WRITE (22) 0, nx, 0, nz+1 ! output part
441	ENDIF
442
443	ENDIF
444
445	CASE ( 23 )
446
447	IF ( data_output_2d_on_each_pe ) THEN
448	OPEN ( 23, FILE='PLOT2D_YZ'//TRIM( coupling_char )//myid_char, &
449	FORM='UNFORMATTED', POSITION='APPEND' )
450	ELSE
451	OPEN ( 23, FILE='PLOT2D_YZ'//TRIM( coupling_char ), &
452	FORM='UNFORMATTED', POSITION='APPEND' )
453	ENDIF
454
455	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
456	!
457	!-- Write index bounds of total domain for combine_plot_fields
458	IF ( data_output_2d_on_each_pe .AND. myid_char /= '' ) THEN
459	WRITE (23) 0, ny, 0, nz+1 ! output part
460	ENDIF
461
462	ENDIF
463
464	CASE ( 25 )
465	!
466	!-- Binary files for surface data
467	OPEN ( 25, FILE='SURFACE_DATA_BIN'//TRIM( coupling_char )//myid_char, &
468	FORM='UNFORMATTED', POSITION='APPEND' )
469
470	CASE ( 26 )
471	!
472	!-- Binary files for averaged surface data
473	OPEN ( 26, FILE='SURFACE_DATA_AV_BIN'//TRIM( coupling_char )//myid_char, &
474	FORM='UNFORMATTED', POSITION='APPEND' )
475
476	CASE ( 27 )
477	!
478	!-- Binary files for virtual measurement data
479	OPEN ( 27, FILE='VIRTUAL_MEAS_BIN'//TRIM( coupling_char )//myid_char,&
480	FORM='UNFORMATTED', POSITION='APPEND' )
481
482	CASE ( 30 )
483
484	OPEN ( 30, FILE='PLOT3D_DATA'//TRIM( coupling_char )//myid_char, &
485	FORM='UNFORMATTED' )
486	!
487	!-- Specifications for combine_plot_fields
488	IF ( myid == 0 ) THEN
489	#if defined( __parallel )
490	WRITE ( 30 ) 0, nx, 0, ny, 0, nz_do3d
491	#endif
492	ENDIF
493
494	CASE ( 80 )
495
496	IF ( myid_char == '' ) THEN
497	OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM(coupling_char)//myid_char, &
498	FORM='FORMATTED', POSITION='APPEND' )
499	ELSE
500	IF ( myid == 0 .AND. .NOT. openfile(80)%opened_before ) THEN
501	CALL local_system( 'mkdir PARTICLE_INFOS' // &
502	TRIM( coupling_char ) )
503	ENDIF
504	#if defined( __parallel )
505	!
506	!-- Set a barrier in order to allow that thereafter all other
507	!-- processors in the directory created by PE0 can open their file.
508	!-- WARNING: The following barrier will lead to hanging jobs, if
509	!-- check_open is first called from routine
510	!-- allocate_prt_memory!
511	IF ( .NOT. openfile(80)%opened_before ) THEN
512	CALL MPI_BARRIER( comm2d, ierr )
513	ENDIF
514	#endif
515	OPEN ( 80, FILE='PARTICLE_INFOS'//TRIM( coupling_char )//'/'// &
516	myid_char, &
517	FORM='FORMATTED', POSITION='APPEND' )
518	ENDIF
519
520	IF ( .NOT. openfile(80)%opened_before ) THEN
521	WRITE ( 80, 8000 ) TRIM( run_description_header )
522	ENDIF
523
524	CASE ( 85 )
525
526	IF ( myid_char == '' ) THEN
527	OPEN ( 85, FILE='PARTICLE_DATA'//TRIM(coupling_char)//myid_char, &
528	FORM='UNFORMATTED', POSITION='APPEND' )
529	ELSE
530	IF ( myid == 0 .AND. .NOT. openfile(85)%opened_before ) THEN
531	CALL local_system( 'mkdir PARTICLE_DATA' // &
532	TRIM( coupling_char ) )
533	ENDIF
534	#if defined( __parallel )
535	!
536	!-- Set a barrier in order to allow that thereafter all other
537	!-- processors in the directory created by PE0 can open their file
538	CALL MPI_BARRIER( comm2d, ierr )
539	#endif
540	ioerr = 1
541	DO WHILE ( ioerr /= 0 )
542	OPEN ( 85, FILE='PARTICLE_DATA'//TRIM( coupling_char )//'/'// &
543	myid_char, &
544	FORM='UNFORMATTED', POSITION='APPEND', IOSTAT=ioerr )
545	IF ( ioerr /= 0 ) THEN
546	WRITE( 9, * ) '*** could not open "PARTICLE_DATA'// &
547	TRIM( coupling_char )//'/'//myid_char// &
548	'"! Trying again in 1 sec.'
549	CALL fortran_sleep( 1 )
550	ENDIF
551	ENDDO
552
553	ENDIF
554
555	IF ( .NOT. openfile(85)%opened_before ) THEN
556	WRITE ( 85 ) run_description_header
557	!
558	!-- Attention: change version number whenever the output format on
559	!-- unit 85 is changed (see also in routine
560	!-- lpm_data_output_particles)
561	rtext = 'data format version 3.1'
562	WRITE ( 85 ) rtext
563	WRITE ( 85 ) number_of_particle_groups, &
564	max_number_of_particle_groups
565	WRITE ( 85 ) particle_groups
566	WRITE ( 85 ) nxl, nxr, nys, nyn, nzb, nzt, nbgp
567	ENDIF
568
569	!
570	!-- File where sky-view factors and further required data is stored will be
571	!-- read
572	CASE ( 88 )
573
574	IF ( myid_char == '' ) THEN
575	OPEN ( 88, FILE='SVFIN'//TRIM( coupling_char )//myid_char, &
576	FORM='UNFORMATTED', STATUS='OLD', IOSTAT=ioerr )
577	ELSE
578
579	OPEN ( 88, FILE='SVFIN'//TRIM( coupling_char )//'/'//myid_char, &
580	FORM='UNFORMATTED', STATUS='OLD', IOSTAT=ioerr )
581	ENDIF
582
583	!
584	!-- File where sky-view factors and further required data is stored will be
585	!-- created
586	CASE ( 89 )
587
588	IF ( myid_char == '' ) THEN
589	OPEN ( 89, FILE='SVFOUT'//TRIM( coupling_char )//myid_char, &
590	FORM='UNFORMATTED', STATUS='NEW' )
591	ELSE
592	IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) THEN
593	CALL local_system( 'mkdir SVFOUT' // TRIM( coupling_char ) )
594	ENDIF
595	#if defined( __parallel )
596	!
597	!-- Set a barrier in order to allow that all other processors in the
598	!-- directory created by PE0 can open their file
599	CALL MPI_BARRIER( comm2d, ierr )
600	#endif
601	ioerr = 1
602	DO WHILE ( ioerr /= 0 )
603	OPEN ( 89, FILE='SVFOUT'//TRIM(coupling_char)//'/'//myid_char, &
604	FORM='UNFORMATTED', STATUS='NEW', IOSTAT=ioerr )
605	IF ( ioerr /= 0 ) THEN
606	WRITE( 9, * ) '*** could not open "SVFOUT'// &
607	TRIM(coupling_char)//'/'//myid_char// &
608	'"! Trying again in 1 sec.'
609	CALL fortran_sleep( 1 )
610	ENDIF
611	ENDDO
612
613	ENDIF
614
615	!
616	!-- Progress file that is used by the PALM watchdog
617	CASE ( 117 )
618
619	OPEN ( 117, FILE='PROGRESS'//TRIM( coupling_char ), &
620	STATUS='REPLACE', FORM='FORMATTED' )
621
622	#if defined( __netcdf )
623	CASE ( 101, 111 )
624	!
625	!-- Set filename depending on unit number
626	IF ( file_id == 101 ) THEN
627	filename = 'DATA_2D_XY_NETCDF' // TRIM( coupling_char )
628	av = 0
629	ELSE
630	filename = 'DATA_2D_XY_AV_NETCDF' // TRIM( coupling_char )
631	av = 1
632	ENDIF
633	!
634	!-- Inquire, if there is a netCDF file from a previuos run. This should
635	!-- be opened for extension, if its dimensions and variables match the
636	!-- actual run.
637	INQUIRE( FILE=filename, EXIST=netcdf_extend )
638	IF ( netcdf_extend ) THEN
639	!
640	!-- Open an existing netCDF file for output
641	CALL netcdf_open_write_file( filename, id_set_xy(av), .TRUE., 20 )
642	!
643	!-- Read header information and set all ids. If there is a mismatch
644	!-- between the previuos and the actual run, netcdf_extend is returned
645	!-- as .FALSE.
646	CALL netcdf_define_header( 'xy', netcdf_extend, av )
647
648	!
649	!-- Remove the local file, if it can not be extended
650	IF ( .NOT. netcdf_extend ) THEN
651	nc_stat = NF90_CLOSE( id_set_xy(av) )
652	CALL netcdf_handle_error( 'check_open', 21 )
653	IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) )
654	#if defined( __parallel )
655	!
656	!-- Set a barrier in order to assure that PE0 deleted the old file
657	!-- before any other processor tries to open a new file.
658	!-- Barrier is only needed in case of parallel I/O
659	IF ( netcdf_data_format > 4 ) CALL MPI_BARRIER( comm2d, ierr )
660	#endif
661	ENDIF
662
663	ENDIF
664
665	IF ( .NOT. netcdf_extend ) THEN
666	!
667	!-- Create a new netCDF output file with requested netCDF format
668	CALL netcdf_create_file( filename, id_set_xy(av), .TRUE., 22 )
669
670	!
671	!-- Define the header
672	CALL netcdf_define_header( 'xy', netcdf_extend, av )
673
674	!
675	!-- In case of parallel netCDF output, create flag file which tells
676	!-- combine_plot_fields that nothing is to do.
677	IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN
678	OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_XY' )
679	WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary'
680	CLOSE( 99 )
681	ENDIF
682
683	ENDIF
684
685	CASE ( 102, 112 )
686	!
687	!-- Set filename depending on unit number
688	IF ( file_id == 102 ) THEN
689	filename = 'DATA_2D_XZ_NETCDF' // TRIM( coupling_char )
690	av = 0
691	ELSE
692	filename = 'DATA_2D_XZ_AV_NETCDF' // TRIM( coupling_char )
693	av = 1
694	ENDIF
695	!
696	!-- Inquire, if there is a netCDF file from a previuos run. This should
697	!-- be opened for extension, if its dimensions and variables match the
698	!-- actual run.
699	INQUIRE( FILE=filename, EXIST=netcdf_extend )
700
701	IF ( netcdf_extend ) THEN
702	!
703	!-- Open an existing netCDF file for output
704	CALL netcdf_open_write_file( filename, id_set_xz(av), .TRUE., 23 )
705	!
706	!-- Read header information and set all ids. If there is a mismatch
707	!-- between the previuos and the actual run, netcdf_extend is returned
708	!-- as .FALSE.
709	CALL netcdf_define_header( 'xz', netcdf_extend, av )
710
711	!
712	!-- Remove the local file, if it can not be extended
713	IF ( .NOT. netcdf_extend ) THEN
714	nc_stat = NF90_CLOSE( id_set_xz(av) )
715	CALL netcdf_handle_error( 'check_open', 24 )
716	IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) )
717	#if defined( __parallel )
718	!
719	!-- Set a barrier in order to assure that PE0 deleted the old file
720	!-- before any other processor tries to open a new file
721	!-- Barrier is only needed in case of parallel I/O
722	IF ( netcdf_data_format > 4 ) CALL MPI_BARRIER( comm2d, ierr )
723	#endif
724	ENDIF
725
726	ENDIF
727
728	IF ( .NOT. netcdf_extend ) THEN
729	!
730	!-- Create a new netCDF output file with requested netCDF format
731	CALL netcdf_create_file( filename, id_set_xz(av), .TRUE., 25 )
732
733	!
734	!-- Define the header
735	CALL netcdf_define_header( 'xz', netcdf_extend, av )
736
737	!
738	!-- In case of parallel netCDF output, create flag file which tells
739	!-- combine_plot_fields that nothing is to do.
740	IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN
741	OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_XZ' )
742	WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary'
743	CLOSE( 99 )
744	ENDIF
745
746	ENDIF
747
748	CASE ( 103, 113 )
749	!
750	!-- Set filename depending on unit number
751	IF ( file_id == 103 ) THEN
752	filename = 'DATA_2D_YZ_NETCDF' // TRIM( coupling_char )
753	av = 0
754	ELSE
755	filename = 'DATA_2D_YZ_AV_NETCDF' // TRIM( coupling_char )
756	av = 1
757	ENDIF
758	!
759	!-- Inquire, if there is a netCDF file from a previuos run. This should
760	!-- be opened for extension, if its dimensions and variables match the
761	!-- actual run.
762	INQUIRE( FILE=filename, EXIST=netcdf_extend )
763
764	IF ( netcdf_extend ) THEN
765	!
766	!-- Open an existing netCDF file for output
767	CALL netcdf_open_write_file( filename, id_set_yz(av), .TRUE., 26 )
768	!
769	!-- Read header information and set all ids. If there is a mismatch
770	!-- between the previuos and the actual run, netcdf_extend is returned
771	!-- as .FALSE.
772	CALL netcdf_define_header( 'yz', netcdf_extend, av )
773
774	!
775	!-- Remove the local file, if it can not be extended
776	IF ( .NOT. netcdf_extend ) THEN
777	nc_stat = NF90_CLOSE( id_set_yz(av) )
778	CALL netcdf_handle_error( 'check_open', 27 )
779	IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) )
780	#if defined( __parallel )
781	!
782	!-- Set a barrier in order to assure that PE0 deleted the old file
783	!-- before any other processor tries to open a new file
784	!-- Barrier is only needed in case of parallel I/O
785	IF ( netcdf_data_format > 4 ) CALL MPI_BARRIER( comm2d, ierr )
786	#endif
787	ENDIF
788
789	ENDIF
790
791	IF ( .NOT. netcdf_extend ) THEN
792	!
793	!-- Create a new netCDF output file with requested netCDF format
794	CALL netcdf_create_file( filename, id_set_yz(av), .TRUE., 28 )
795
796	!
797	!-- Define the header
798	CALL netcdf_define_header( 'yz', netcdf_extend, av )
799
800	!
801	!-- In case of parallel netCDF output, create flag file which tells
802	!-- combine_plot_fields that nothing is to do.
803	IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN
804	OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_YZ' )
805	WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary'
806	CLOSE( 99 )
807	ENDIF
808
809	ENDIF
810
811	CASE ( 104 )
812	!
813	!-- Set filename
814	filename = 'DATA_1D_PR_NETCDF' // TRIM( coupling_char )
815
816	!
817	!-- Inquire, if there is a netCDF file from a previuos run. This should
818	!-- be opened for extension, if its variables match the actual run.
819	INQUIRE( FILE=filename, EXIST=netcdf_extend )
820
821	IF ( netcdf_extend ) THEN
822	!
823	!-- Open an existing netCDF file for output
824	CALL netcdf_open_write_file( filename, id_set_pr, .FALSE., 29 )
825	!
826	!-- Read header information and set all ids. If there is a mismatch
827	!-- between the previuos and the actual run, netcdf_extend is returned
828	!-- as .FALSE.
829	CALL netcdf_define_header( 'pr', netcdf_extend, 0 )
830
831	!
832	!-- Remove the local file, if it can not be extended
833	IF ( .NOT. netcdf_extend ) THEN
834	nc_stat = NF90_CLOSE( id_set_pr )
835	CALL netcdf_handle_error( 'check_open', 30 )
836	CALL local_system( 'rm ' // TRIM( filename ) )
837	ENDIF
838
839	ENDIF
840
841	IF ( .NOT. netcdf_extend ) THEN
842	!
843	!-- Create a new netCDF output file with requested netCDF format
844	CALL netcdf_create_file( filename, id_set_pr, .FALSE., 31 )
845	!
846	!-- Define the header
847	CALL netcdf_define_header( 'pr', netcdf_extend, 0 )
848
849	ENDIF
850
851	CASE ( 105 )
852	!
853	!-- Set filename
854	filename = 'DATA_1D_TS_NETCDF' // TRIM( coupling_char )
855
856	!
857	!-- Inquire, if there is a netCDF file from a previuos run. This should
858	!-- be opened for extension, if its variables match the actual run.
859	INQUIRE( FILE=filename, EXIST=netcdf_extend )
860
861	IF ( netcdf_extend ) THEN
862	!
863	!-- Open an existing netCDF file for output
864	CALL netcdf_open_write_file( filename, id_set_ts, .FALSE., 32 )
865	!
866	!-- Read header information and set all ids. If there is a mismatch
867	!-- between the previuos and the actual run, netcdf_extend is returned
868	!-- as .FALSE.
869	CALL netcdf_define_header( 'ts', netcdf_extend, 0 )
870
871	!
872	!-- Remove the local file, if it can not be extended
873	IF ( .NOT. netcdf_extend ) THEN
874	nc_stat = NF90_CLOSE( id_set_ts )
875	CALL netcdf_handle_error( 'check_open', 33 )
876	CALL local_system( 'rm ' // TRIM( filename ) )
877	ENDIF
878
879	ENDIF
880
881	IF ( .NOT. netcdf_extend ) THEN
882	!
883	!-- Create a new netCDF output file with requested netCDF format
884	CALL netcdf_create_file( filename, id_set_ts, .FALSE., 34 )
885	!
886	!-- Define the header
887	CALL netcdf_define_header( 'ts', netcdf_extend, 0 )
888
889	ENDIF
890
891
892	CASE ( 106, 116 )
893	!
894	!-- Set filename depending on unit number
895	IF ( file_id == 106 ) THEN
896	filename = 'DATA_3D_NETCDF' // TRIM( coupling_char )
897	av = 0
898	ELSE
899	filename = 'DATA_3D_AV_NETCDF' // TRIM( coupling_char )
900	av = 1
901	ENDIF
902	!
903	!-- Inquire, if there is a netCDF file from a previous run. This should
904	!-- be opened for extension, if its dimensions and variables match the
905	!-- actual run.
906	INQUIRE( FILE=filename, EXIST=netcdf_extend )
907	IF ( netcdf_extend ) THEN
908	!
909	!-- Open an existing netCDF file for output
910	CALL netcdf_open_write_file( filename, id_set_3d(av), .TRUE., 35 )
911	!
912	!-- Read header information and set all ids. If there is a mismatch
913	!-- between the previuos and the actual run, netcdf_extend is returned
914	!-- as .FALSE.
915	CALL netcdf_define_header( '3d', netcdf_extend, av )
916
917	!
918	!-- Remove the local file, if it can not be extended
919	IF ( .NOT. netcdf_extend ) THEN
920	nc_stat = NF90_CLOSE( id_set_3d(av) )
921	CALL netcdf_handle_error( 'check_open', 36 )
922	IF ( myid == 0 ) CALL local_system( 'rm ' // TRIM( filename ) )
923	#if defined( __parallel )
924	!
925	!-- Set a barrier in order to assure that PE0 deleted the old file
926	!-- before any other processor tries to open a new file
927	!-- Barrier is only needed in case of parallel I/O
928	IF ( netcdf_data_format > 4 ) CALL MPI_BARRIER( comm2d, ierr )
929	#endif
930	ENDIF
931
932	ENDIF
933
934	IF ( .NOT. netcdf_extend ) THEN
935	!
936	!-- Create a new netCDF output file with requested netCDF format
937	CALL netcdf_create_file( filename, id_set_3d(av), .TRUE., 37 )
938
939	!
940	!-- Define the header
941	CALL netcdf_define_header( '3d', netcdf_extend, av )
942
943	!
944	!-- In case of parallel netCDF output, create flag file which tells
945	!-- combine_plot_fields that nothing is to do.
946	IF ( myid == 0 .AND. netcdf_data_format > 4 ) THEN
947	OPEN( 99, FILE='NO_COMBINE_PLOT_FIELDS_3D' )
948	WRITE ( 99, '(A)' ) 'no combine_plot_fields.x neccessary'
949	CLOSE( 99 )
950	ENDIF
951
952	ENDIF
953
954
955	CASE ( 107 )
956	!
957	!-- Set filename
958	filename = 'DATA_1D_SP_NETCDF' // TRIM( coupling_char )
959
960	!
961	!-- Inquire, if there is a netCDF file from a previuos run. This should
962	!-- be opened for extension, if its variables match the actual run.
963	INQUIRE( FILE=filename, EXIST=netcdf_extend )
964
965	IF ( netcdf_extend ) THEN
966	!
967	!-- Open an existing netCDF file for output
968	CALL netcdf_open_write_file( filename, id_set_sp, .FALSE., 38 )
969
970	!
971	!-- Read header information and set all ids. If there is a mismatch
972	!-- between the previuos and the actual run, netcdf_extend is returned
973	!-- as .FALSE.
974	CALL netcdf_define_header( 'sp', netcdf_extend, 0 )
975
976	!
977	!-- Remove the local file, if it can not be extended
978	IF ( .NOT. netcdf_extend ) THEN
979	nc_stat = NF90_CLOSE( id_set_sp )
980	CALL netcdf_handle_error( 'check_open', 39 )
981	CALL local_system( 'rm ' // TRIM( filename ) )
982	ENDIF
983
984	ENDIF
985
986	IF ( .NOT. netcdf_extend ) THEN
987	!
988	!-- Create a new netCDF output file with requested netCDF format
989	CALL netcdf_create_file( filename, id_set_sp, .FALSE., 40 )
990	!
991	!-- Define the header
992	CALL netcdf_define_header( 'sp', netcdf_extend, 0 )
993
994	ENDIF
995
996	!
997	!-- Currently disabled
998	! CASE ( 108 )
999
1000	! IF ( myid_char == '' ) THEN
1001	! filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char )
1002	! ELSE
1003	! filename = 'DATA_PRT_NETCDF' // TRIM( coupling_char ) // '/' // &
1004	! myid_char
1005	! ENDIF
1006	!
1007	!-- Inquire, if there is a netCDF file from a previuos run. This should
1008	!-- be opened for extension, if its variables match the actual run.
1009	! INQUIRE( FILE=filename, EXIST=netcdf_extend )
1010
1011	! IF ( netcdf_extend ) THEN
1012	!
1013	!-- Open an existing netCDF file for output
1014	! CALL netcdf_open_write_file( filename, id_set_prt, .FALSE., 41 )
1015	!
1016	!-- Read header information and set all ids. If there is a mismatch
1017	!-- between the previuos and the actual run, netcdf_extend is returned
1018	!-- as .FALSE.
1019	! CALL netcdf_define_header( 'pt', netcdf_extend, 0 )
1020
1021	!
1022	!-- Remove the local file, if it can not be extended
1023	! IF ( .NOT. netcdf_extend ) THEN
1024	! nc_stat = NF90_CLOSE( id_set_prt )
1025	! CALL netcdf_handle_error( 'check_open', 42 )
1026	! CALL local_system( 'rm ' // TRIM( filename ) )
1027	! ENDIF
1028
1029	! ENDIF
1030
1031	! IF ( .NOT. netcdf_extend ) THEN
1032
1033	!
1034	!-- For runs on multiple processors create the subdirectory
1035	! IF ( myid_char /= '' ) THEN
1036	! IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) &
1037	! THEN ! needs modification in case of non-extendable sets
1038	! CALL local_system( 'mkdir DATA_PRT_NETCDF' // &
1039	! TRIM( coupling_char ) // '/' )
1040	! ENDIF
1041	#if defined( __parallel )
1042	!
1043	!-- Set a barrier in order to allow that all other processors in the
1044	!-- directory created by PE0 can open their file
1045	! CALL MPI_BARRIER( comm2d, ierr )
1046	#endif
1047	! ENDIF
1048
1049	!
1050	!-- Create a new netCDF output file with requested netCDF format
1051	! CALL netcdf_create_file( filename, id_set_prt, .FALSE., 43 )
1052
1053	!
1054	!-- Define the header
1055	! CALL netcdf_define_header( 'pt', netcdf_extend, 0 )
1056
1057	! ENDIF
1058
1059	CASE ( 109 )
1060	!
1061	!-- Set filename
1062	filename = 'DATA_1D_PTS_NETCDF' // TRIM( coupling_char )
1063
1064	!
1065	!-- Inquire, if there is a netCDF file from a previuos run. This should
1066	!-- be opened for extension, if its variables match the actual run.
1067	INQUIRE( FILE=filename, EXIST=netcdf_extend )
1068
1069	IF ( netcdf_extend ) THEN
1070	!
1071	!-- Open an existing netCDF file for output
1072	CALL netcdf_open_write_file( filename, id_set_pts, .FALSE., 393 )
1073	!
1074	!-- Read header information and set all ids. If there is a mismatch
1075	!-- between the previuos and the actual run, netcdf_extend is returned
1076	!-- as .FALSE.
1077	CALL netcdf_define_header( 'ps', netcdf_extend, 0 )
1078
1079	!
1080	!-- Remove the local file, if it can not be extended
1081	IF ( .NOT. netcdf_extend ) THEN
1082	nc_stat = NF90_CLOSE( id_set_pts )
1083	CALL netcdf_handle_error( 'check_open', 394 )
1084	CALL local_system( 'rm ' // TRIM( filename ) )
1085	ENDIF
1086
1087	ENDIF
1088
1089	IF ( .NOT. netcdf_extend ) THEN
1090	!
1091	!-- Create a new netCDF output file with requested netCDF format
1092	CALL netcdf_create_file( filename, id_set_pts, .FALSE., 395 )
1093	!
1094	!-- Define the header
1095	CALL netcdf_define_header( 'ps', netcdf_extend, 0 )
1096
1097	ENDIF
1098
1099	CASE ( 118 )
1100
1101	IF ( myid == 0 ) THEN
1102	filename = 'DATA_AGT_NETCDF'
1103	!
1104	!-- Inquire, if there is a netCDF file from a previuos run. This should
1105	!-- be opened for extension, if its variables match the actual run.
1106	INQUIRE( FILE=filename, EXIST=netcdf_extend )
1107
1108	!
1109	!-- Create a new netCDF output file with requested netCDF format
1110	CALL netcdf_create_file( filename, id_set_agt, .FALSE., 43 )
1111
1112	!
1113	!-- Define the header
1114	CALL netcdf_define_header( 'ag', netcdf_extend, 0 )
1115	ENDIF
1116
1117	! IF ( netcdf_extend ) THEN
1118	! !
1119	! !-- Open an existing netCDF file for output
1120	! CALL netcdf_open_write_file( filename, id_set_agt, .FALSE., 41 )
1121	! !
1122	! !-- Read header information and set all ids. If there is a mismatch
1123	! !-- between the previuos and the actual run, netcdf_extend is returned
1124	! !-- as .FALSE.
1125	! CALL netcdf_define_header( 'ag', netcdf_extend, 0 )
1126	!
1127	! !
1128	! !-- Remove the local file, if it can not be extended
1129	! IF ( .NOT. netcdf_extend ) THEN
1130	! nc_stat = NF90_CLOSE( id_set_agt )
1131	! CALL netcdf_handle_error( 'check_open', 42 )
1132	! CALL local_system( 'rm ' // TRIM( filename ) )
1133	! ENDIF
1134	!
1135	! ENDIF
1136
1137	IF ( .NOT. netcdf_extend ) THEN
1138
1139	!
1140	! !-- For runs on multiple processors create the subdirectory
1141	! IF ( myid_char /= '' ) THEN
1142	! IF ( myid == 0 .AND. .NOT. openfile(file_id)%opened_before ) &
1143	! THEN ! needs modification in case of non-extendable sets
1144	! CALL local_system( 'mkdir DATA_PRT_NETCDF' // &
1145	! TRIM( coupling_char ) // '/' )
1146	! ENDIF
1147	! #if defined( __parallel )
1148	! !
1149	! !-- Set a barrier in order to allow that all other processors in the
1150	! !-- directory created by PE0 can open their file
1151	! CALL MPI_BARRIER( comm2d, ierr )
1152	! #endif
1153	! ENDIF
1154
1155	ENDIF
1156
1157
1158	!
1159	!-- nc-file for virtual flight measurements
1160	CASE ( 199 )
1161	!
1162	!-- Set filename
1163	filename = 'DATA_1D_FL_NETCDF' // TRIM( coupling_char )
1164
1165	!
1166	!-- Inquire, if there is a netCDF file from a previuos run. This should
1167	!-- be opened for extension, if its variables match the actual run.
1168	INQUIRE( FILE=filename, EXIST=netcdf_extend )
1169
1170	IF ( netcdf_extend ) THEN
1171	!
1172	!-- Open an existing netCDF file for output
1173	CALL netcdf_open_write_file( filename, id_set_fl, .FALSE., 532 )
1174	!
1175	!-- Read header information and set all ids. If there is a mismatch
1176	!-- between the previuos and the actual run, netcdf_extend is returned
1177	!-- as .FALSE.
1178	CALL netcdf_define_header( 'fl', netcdf_extend, 0 )
1179
1180	!
1181	!-- Remove the local file, if it can not be extended
1182	IF ( .NOT. netcdf_extend ) THEN
1183	nc_stat = NF90_CLOSE( id_set_fl )
1184	CALL netcdf_handle_error( 'check_open', 533 )
1185	CALL local_system( 'rm ' // TRIM( filename ) )
1186	ENDIF
1187
1188	ENDIF
1189
1190	IF ( .NOT. netcdf_extend ) THEN
1191	!
1192	!-- Create a new netCDF output file with requested netCDF format
1193	CALL netcdf_create_file( filename, id_set_fl, .FALSE., 534 )
1194	!
1195	!-- Define the header
1196	CALL netcdf_define_header( 'fl', netcdf_extend, 0 )
1197
1198	ENDIF
1199
1200
1201	CASE ( 201:200+2*max_masks )
1202	!
1203	!-- Set filename depending on unit number
1204	IF ( file_id <= 200+max_masks ) THEN
1205	mid = file_id - 200
1206	WRITE ( mask_char,'(A2,I2.2)') '_M', mid
1207	filename = 'DATA_MASK_NETCDF' // TRIM( coupling_char ) // &
1208	mask_char
1209	av = 0
1210	ELSE
1211	mid = file_id - (200+max_masks)
1212	WRITE ( mask_char,'(A2,I2.2)') '_M', mid
1213	filename = 'DATA_MASK_AV_NETCDF' // TRIM( coupling_char ) // &
1214	mask_char
1215	av = 1
1216	ENDIF
1217	!
1218	!-- Inquire, if there is a netCDF file from a previuos run. This should
1219	!-- be opened for extension, if its dimensions and variables match the
1220	!-- actual run.
1221	INQUIRE( FILE=filename, EXIST=netcdf_extend )
1222
1223	IF ( netcdf_extend ) THEN
1224	!
1225	!-- Open an existing netCDF file for output
1226	CALL netcdf_open_write_file( filename, id_set_mask(mid,av), &
1227	.TRUE., 456 )
1228	!
1229	!-- Read header information and set all ids. If there is a mismatch
1230	!-- between the previuos and the actual run, netcdf_extend is returned
1231	!-- as .FALSE.
1232	CALL netcdf_define_header( 'ma', netcdf_extend, file_id )
1233
1234	!
1235	!-- Remove the local file, if it can not be extended
1236	IF ( .NOT. netcdf_extend ) THEN
1237	nc_stat = NF90_CLOSE( id_set_mask(mid,av) )
1238	CALL netcdf_handle_error( 'check_open', 457 )
1239	CALL local_system('rm ' // TRIM( filename ) )
1240	ENDIF
1241
1242	ENDIF
1243
1244	IF ( .NOT. netcdf_extend ) THEN
1245	!
1246	!-- Create a new netCDF output file with requested netCDF format
1247	CALL netcdf_create_file( filename, id_set_mask(mid,av), .TRUE., 458 )
1248	!
1249	!-- Define the header
1250	CALL netcdf_define_header( 'ma', netcdf_extend, file_id )
1251
1252	ENDIF
1253
1254
1255	#else
1256
1257	CASE ( 101:109, 111:113, 116, 201:200+2*max_masks )
1258
1259	!
1260	!-- Nothing is done in case of missing netcdf support
1261	RETURN
1262
1263	#endif
1264
1265	CASE DEFAULT
1266
1267	WRITE( message_string, * ) 'no OPEN-statement for file-id ',file_id
1268	CALL message( 'check_open', 'PA0172', 2, 2, -1, 6, 1 )
1269
1270	END SELECT
1271
1272	!
1273	!-- Set open flag
1274	openfile(file_id)%opened = .TRUE.
1275
1276	!
1277	!-- Formats
1278	8000 FORMAT (A/ &
1279	' step time # of parts lPE sent/recv rPE sent/recv ',&
1280	'sPE sent/recv nPE sent/recv max # of parts '/ &
1281	109('-'))
1282
1283	END SUBROUTINE check_open

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |