Home

Context Navigation

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

Last change on this file since 32 was 4, checked in by raasch, 18 years ago
Id keyword set as property for all *.f90 files
Property svn:keywords set to `Id`
File size: 44.3 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |