Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |