Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |