Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |