Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |