Home

Context Navigation

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

Last change on this file since 2267 was 2101, checked in by suehring, 8 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 44.5 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |