Home

Context Navigation

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

Last change on this file since 2837 was 2718, checked in by maronga, 7 years ago
deleting of deprecated files; headers updated where needed
Property svn:keywords set to `Id`
File size: 40.9 KB

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

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

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |