Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |