Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |