Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |