Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |