Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |