Home

Context Navigation

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

Last change on this file since 254 was 247, checked in by heinze, 16 years ago
Output of messages replaced by message handling routin
Property svn:keywords set to `Id`
File size: 46.2 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |