Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |