Home

Context Navigation

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

Last change on this file since 1353 was 1353, checked in by heinze, 10 years ago
REAL constants provided with KIND-attribute
Property svn:keywords set to `Id`
File size: 40.3 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |