Home

Context Navigation

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

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |