Home

Context Navigation

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

Last change on this file since 4089 was 4069, checked in by Giersch, 5 years ago
Bugfix for masked output, compiler warning removed, test case for wind turbine model revised
Property svn:keywords set to `Id`
File size: 49.2 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |