Home

Context Navigation

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

Last change on this file since 1103 was 1093, checked in by raasch, 12 years ago
last commit documented
Property svn:keywords set to `Id`
File size: 46.0 KB

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