Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |