Home

Context Navigation

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

Last change on this file since 245 was 198, checked in by raasch, 16 years ago
file headers updated for the next release 3.5
Property svn:keywords set to `Id`
File size: 45.8 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |