Home

Context Navigation

check_open.f90 @ 4830

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

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

Context Navigation

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

Download in other formats: