Home

Context Navigation

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

Last change on this file since 497 was 494, checked in by raasch, 15 years ago
last commit documented; configuration example file for netcdf4 added
Property svn:keywords set to `Id`
File size: 53.9 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |