Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |