Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |